mirror of git://git.psyced.org/git/psyclpc
4740 lines
134 KiB
C
4740 lines
134 KiB
C
/*---------------------------------------------------------------------------
|
|
* Mapping handling functions.
|
|
*
|
|
*---------------------------------------------------------------------------
|
|
* TODO: Rewrite the low-level functions (like allocate_mapping()) to return
|
|
* TODO:: failure codes (errno like) instead of throwing errors. In addition,
|
|
* TODO:: provide wrapper functions which do throw errorf()s, so that every
|
|
* TODO:: caller can handle the errors himself (like the swapper).
|
|
*
|
|
* TODO: A better mapping implementation would utilise the to-be-written
|
|
* TODO:: small block pools. The mapping entries would be unified to
|
|
* TODO:: (hash header:key:values) tuples and stored in a pool.
|
|
* TODO:: The 'compacted' part of the mapping would obviously go away,
|
|
* TODO:: and all indexing would be done through hash table.
|
|
* TODO:: The pool is not absolutely required, but would reduce overhead if
|
|
* TODO:: MALLOC_TRACE is in effect.
|
|
*
|
|
* TODO: Check if the use of mp_int is reasonable for values for num_values
|
|
* TODO::and num_entries (which are in the struct p_int). And check as
|
|
* TODO::the wild mixture of mp_int, p_int, size_t (and maybe still int?)
|
|
* TODO::used for iterating over mapping structures.
|
|
*
|
|
* Mappings, or 'associative arrays', are similar to normal arrays, with
|
|
* the principal difference that they can use every value to index their
|
|
* stored data, whereas arrays only index with integer values. On the
|
|
* other hand this means that in mappings the data is not stored in any
|
|
* particular order, whereas arrays imply an order through their indexing.
|
|
*
|
|
* LPMud mappings in extension allow to store several values for each
|
|
* index value. This behaviour is functionally equivalent to a 'normal'
|
|
* mapping holding arrays as data, but its direct implementation allows
|
|
* certain optimisations.
|
|
*
|
|
* NB: Where strings are used as index value, they are made shared strings.
|
|
*
|
|
*
|
|
* A mapping consists of several structures (defined in mapping.h):
|
|
*
|
|
* - the mapping_t is the base of all mappings.
|
|
* - mapping_cond_t holds the condensed entries
|
|
* - mapping_hash_t holds the hashed entries added since the
|
|
* creation of the mapping_cond_t block.
|
|
*
|
|
* Using this approach, mappings manage to combine a low memory overhead
|
|
* with fast operation. Both the hashed and the condensed part may
|
|
* be absent.
|
|
*
|
|
* The key values are sorted according to svalue_cmp(), that is in principle
|
|
* by (.type, .u.number >> 1, .x.generic), with the exception of closures and
|
|
* strings which have their own sorting order within their .type.
|
|
*
|
|
* Since the x.generic information is also used to generate the hash value for
|
|
* hashing, for values which don't have a secondary information, x.generic is
|
|
* set to .u.number << 1.
|
|
*
|
|
* The mapping_cond_t block holds mapping entries in sorted order.
|
|
* Deleted entries are signified by a T_INVALID key value and can appear
|
|
* out of order. The data values for a deleted entry are set to svalue-0.
|
|
*
|
|
* The mapping_hash_t block is used to record all the new additions to
|
|
* the mapping since the last compaction. The new entries' data is kept
|
|
* directly in the hash entries. The hash table grows with the
|
|
* number of hashed entries, so that the average chain length is
|
|
* no more than 2. For easier computations,the number of buckets
|
|
* is always a power of 2.
|
|
*
|
|
* All mappings with a mapping_hash_t structure are considered 'dirty'
|
|
* (and vice versa, only 'dirty' mappings have a mapping_hash_t).
|
|
* During the regular object cleanup, the backend will find and 'clean'
|
|
* the dirty mappings by sorting the hashed entries into the condensed part,
|
|
* removing the hashed part by this.
|
|
*
|
|
* To be compacted, a mapping has to conform to a number of conditions:
|
|
* - it has been at least TIME_TO_COMPACT seconds (typical 10 minutes)
|
|
* since the last addition or deletion of an entry
|
|
* and
|
|
* - it was to be at least 2*TIME_TO_COMPACT seconds (typical 20 minutes)
|
|
* since the last addition or deletion of an entry
|
|
* or - the number of condensed-deleted entries is at least half the capacity
|
|
* of the condensed part
|
|
* or - the number of hashed entries exceeds the number non-deleted condensed
|
|
* entries.
|
|
*
|
|
* The idea is to minimize reallocations of the (potentially large) condensed
|
|
* block, as it easily runs into fragmentation of the large block heap.
|
|
*
|
|
* A garbage collection however compacts all mappings unconditionally.
|
|
*
|
|
*
|
|
* Mappings maintain two refcounts: the main refcount for all references,
|
|
* and in the hash structure a protector refcount for references as
|
|
* PROTECTED_MAPPING. The latter references are used for 'dirty' mappings
|
|
* (ie. mappings with a hash part) which are passed fully or in part as a
|
|
* reference to a function. As long as the protector refcount is not 0, all
|
|
* entry deletions are not executed immediately. Instead, the 'deleted'
|
|
* entries are kept in a separate list until all protective references
|
|
* are removed. PROTECTED_MAPPINGs don't need to protect the condensed
|
|
* part of a mapping as that changes only during compact_mapping()s
|
|
* in the backend.
|
|
*
|
|
*
|
|
* -- mapping_t --
|
|
*
|
|
* mapping_t {
|
|
* p_int ref;
|
|
* wiz_list_t * user;
|
|
* int num_values;
|
|
* p_int num_entries;
|
|
*
|
|
* mapping_cond_t * cond;
|
|
* mapping_hash_t * hash;
|
|
*
|
|
* mapping_t * next;
|
|
* }
|
|
*
|
|
* .ref is the number of references, as usual.
|
|
*
|
|
* .user is, as usual, the wizlist entry of the owner object.
|
|
*
|
|
* .num_values and .num_entries give the width (excluding the key!)
|
|
* and number of valid entries in the mapping.
|
|
*
|
|
* .cond and .hash are the condensed resp. hashed data blocks.
|
|
* .hash also serves as indicator if the mapping is 'dirty',
|
|
* and therefore contains all the information about the dirtyness.
|
|
*
|
|
* The .next pointer is not used by the mapping module itself,
|
|
* but is provided as courtesy for the cleanup code and the GC, to
|
|
* avoid additional memory allocations during a low memory situation.
|
|
* The cleanup code uses it to keep its list of dirty mappings; the
|
|
* GC uses it to keep its list of stale mappings (ie. mappings with
|
|
* keys referencing destructed objects).
|
|
*
|
|
* -- mapping_cond_t --
|
|
*
|
|
* mapping_cond_t {
|
|
* size_t size;
|
|
* svalue_t *data[(mapping->num_values+1) * .size];
|
|
* }
|
|
*
|
|
* This structure holds the .size compacted entries for a mapping (.size
|
|
* includes the deleted entries as well, if any).
|
|
*
|
|
* The first .size svalues in .data[] are the keys. Follwing are the
|
|
* actual data values, the values for one entry each in one row.
|
|
*
|
|
* If a key is .data[ix], its data values are in
|
|
* .data[.size + ix * mapping->num_values] through
|
|
* .data[.size + (ix+1) * mapping->num_values - 1].
|
|
*
|
|
* If an entry is deleted, the key's .type is set to T_INVALID and
|
|
* the data values are zeroed out (and mapping->hash->cond_deleted is
|
|
* incremented), but the entry is otherwise left in place.
|
|
*
|
|
* -- mapping_hash_t --
|
|
*
|
|
* hash_mapping_t {
|
|
* p_int mask;
|
|
* p_int used;
|
|
* p_int cond_deleted;
|
|
* p_int ref;
|
|
* mp_int last_used;
|
|
* map_chain_t *deleted;
|
|
* map_chain_t *chains[ 1 +.mask ];
|
|
* }
|
|
*
|
|
* This structure keeps track of the changes to a mapping. Every mapping
|
|
* with a hash part is considered 'dirty'.
|
|
*
|
|
* New entries to the mapping are kept in the hashtable made up by
|
|
* .chains[]. There are .mask+1 different chains, with .mask+1 always
|
|
* being a power of two. This way, .mask can be used in a binary-&
|
|
* operation to convert a hash value into a chain index. The number
|
|
* of entries in the hashtable is listed in .used.
|
|
*
|
|
* The driver imposes an upper limit onto the average length of the
|
|
* chains: if the average length exceeds two elements, the size of
|
|
* the hashtable is doubled (by reallocating the hash_mapping structure).
|
|
* This is the reason why you can allocate a mapping with a given 'size':
|
|
* it reduces the number of reallocations in the long run.
|
|
*
|
|
* .condensed_deleted gives the number of deleted entries in
|
|
* the mappings condensed_part.
|
|
*
|
|
* .ref and .deleted come into use when the mapping is used as
|
|
* protector mapping. Protector mappings are necessary whenever
|
|
* single values of the mapping are used as lvalues, in order to
|
|
* protect them against premature deletion ( map[0] = ({ map=0 })
|
|
* being the classic case). .ref counts the number of such
|
|
* protective references, and is always <= mapping.ref. .deleted
|
|
* is the list of entries deleted from the mapping while the
|
|
* protection is in effect. If the .ref falls back to 0, all
|
|
* the pending deletions of the .deleted entries are performed.
|
|
*
|
|
* .last_used holds the time (seconds since the epoch) of the last addition
|
|
* or removal of an entry. It is used by the compaction algorithm to
|
|
* determine whether the mapping should be compacted or not.
|
|
*
|
|
* -- map_chain_t --
|
|
*
|
|
* This structure is used to keep single entries in the hash chains
|
|
* of hash_mapping, and occasionally, in the .deleted list of
|
|
* protector mappings.
|
|
*
|
|
* map_chain_t {
|
|
* map_chain_t *next;
|
|
* svalue_t data[ mapping->num_values+1 ];
|
|
* }
|
|
*
|
|
* .next is the next struct map_chain in the hash chain (or .deleted list).
|
|
* .data holds the key and it's data values.
|
|
*
|
|
*---------------------------------------------------------------------------
|
|
*/
|
|
|
|
#include "driver.h"
|
|
#include "typedefs.h"
|
|
|
|
#include "my-alloca.h"
|
|
#include <stdio.h>
|
|
|
|
#include "mapping.h"
|
|
|
|
#include "array.h"
|
|
#include "backend.h"
|
|
#include "closure.h"
|
|
#include "gcollect.h"
|
|
#include "interpret.h"
|
|
#include "main.h"
|
|
#include "mstrings.h"
|
|
#include "object.h"
|
|
#include "simulate.h"
|
|
#ifdef USE_STRUCTS
|
|
#include "structs.h"
|
|
#endif /* USE_STRUCTS */
|
|
#include "svalue.h"
|
|
#include "wiz_list.h"
|
|
#include "xalloc.h"
|
|
|
|
#include "i-svalue_cmp.h"
|
|
|
|
#define TIME_TO_COMPACT (600) /* 10 Minutes */
|
|
/* TODO: Make this configurable.
|
|
* TODO:: When doing so, also implement the shrinking of the hashtable
|
|
*/
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
/* Types */
|
|
|
|
/* The local typedefs */
|
|
typedef struct map_chain_s map_chain_t;
|
|
|
|
|
|
/* --- struct map_chain_s: one entry in a hash chain ---
|
|
*
|
|
* The hashed mapping entries.
|
|
*/
|
|
|
|
struct map_chain_s {
|
|
map_chain_t * next; /* next entry */
|
|
svalue_t data[1 /* +mapping->num_values */];
|
|
/* [0]: the key, [1..]: the data */
|
|
};
|
|
|
|
#define SIZEOF_MCH(mch, nv) ( \
|
|
sizeof(*mch) + (nv) * sizeof(svalue_t) \
|
|
)
|
|
/* Allocation size of a map_chain_t for <nv> values per key.
|
|
*/
|
|
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
|
|
mp_int num_mappings = 0;
|
|
/* Number of allocated mappings.
|
|
*/
|
|
|
|
mp_int num_hash_mappings = 0;
|
|
/* Number of allocated mappings with only a hash part.
|
|
*/
|
|
|
|
mp_int num_dirty_mappings = 0;
|
|
/* Number of allocated mappings with a hash and a condensed part.
|
|
*/
|
|
|
|
mapping_t *stale_mappings;
|
|
/* During a garbage collection, this is a list of mappings with
|
|
* keys referencing destructed objects/lambdas, linked through
|
|
* the .next pointers. Since th GC performs a global cleanup first,
|
|
* this list is normally empty, but having it increases the robustness
|
|
* of the GC.
|
|
*/
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
/* Forward declarations */
|
|
|
|
#if 0
|
|
|
|
/* TODO: Remove these defines when the statistics prove to be correct */
|
|
|
|
#define LOG_ALLOC(where,add,alloc) \
|
|
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))
|
|
|
|
#define LOG_ADD(where,add) \
|
|
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))
|
|
|
|
#define LOG_SUB(where,sub) \
|
|
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))
|
|
|
|
#define LOG_SUB_M(where,m,sub) \
|
|
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))
|
|
|
|
#else
|
|
|
|
#define LOG_ALLOC(where,add,alloc)
|
|
#define LOG_ADD(where,add)
|
|
#define LOG_SUB(where,add)
|
|
#define LOG_SUB_M(where,m,add)
|
|
|
|
#endif
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
static INLINE map_chain_t *
|
|
new_map_chain (mapping_t * m)
|
|
|
|
/* Return a fresh map_chain_t for mapping <m>.
|
|
* The .data[] values are not initialised.
|
|
*
|
|
* Return NULL if out of memory.
|
|
*/
|
|
|
|
{
|
|
map_chain_t *rc;
|
|
|
|
rc = xalloc(SIZEOF_MCH(rc, m->num_values));
|
|
if (rc)
|
|
{
|
|
LOG_ALLOC("new_map_chain", SIZEOF_MCH(rc, m->num_values), SIZEOF_MCH(rc, m->num_values));
|
|
m->user->mapping_total += SIZEOF_MCH(rc, m->num_values);
|
|
}
|
|
|
|
return rc;
|
|
} /* new_map_chain() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
static INLINE void
|
|
free_map_chain (mapping_t * m, map_chain_t *mch, Bool no_data)
|
|
|
|
/* Free the map_chain <mch> of mapping <m>.
|
|
* If <no_data> is TRUE, the svalues themselves are supposed to be empty.
|
|
*/
|
|
|
|
{
|
|
p_int ix;
|
|
|
|
if (!no_data)
|
|
{
|
|
for (ix = m->num_values; ix >= 0; ix--)
|
|
{
|
|
free_svalue(mch->data+ix);
|
|
}
|
|
}
|
|
|
|
LOG_SUB("free_map_chain", SIZEOF_MCH(mch, m->num_values));
|
|
m->user->mapping_total -= SIZEOF_MCH(mch, m->num_values);
|
|
xfree(mch);
|
|
} /* free_map_chain() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
static INLINE mapping_hash_t *
|
|
get_new_hash ( mapping_t *m, mp_int hash_size)
|
|
|
|
/* Allocate a new hash structure for mapping <m>, prepared to take
|
|
* <hash_size> entries. The hash structure is NOT linked into <m>.
|
|
*
|
|
* Return the new structure, or NULL when out of memory.
|
|
*/
|
|
/* TODO: hash_size of mp_int seems unnecessarily large to me, because
|
|
* TODO::mappings can only have p_int values? */
|
|
{
|
|
mapping_hash_t *hm;
|
|
map_chain_t **mcp;
|
|
|
|
/* Compute the number of hash buckets to 2**k, where
|
|
* k is such that 2**(k+1) > size >= 2**k.
|
|
*
|
|
* To do this, compute 'size' to (2**k)-1 by first setting
|
|
* all bits after the leading '1' and then shifting the
|
|
* number right once. The result is then also the mask
|
|
* required for indexing.
|
|
*/
|
|
hash_size |= hash_size >> 1;
|
|
hash_size |= hash_size >> 2;
|
|
hash_size |= hash_size >> 4;
|
|
if (hash_size & ~0xff)
|
|
{
|
|
hash_size |= hash_size >> 8;
|
|
hash_size |= hash_size >> 16;
|
|
}
|
|
hash_size >>= 1;
|
|
|
|
/* Allocate the hash_mapping big enough to hold (size+1) hash
|
|
* buckets.
|
|
* size must not exceed the accessible indexing range. This is
|
|
* a possibility because size as a mp_int may have a different
|
|
* range than array indices which are size_t.
|
|
* TODO: The 0x100000 seems to be a safety offset, but is it?
|
|
*/
|
|
if (hash_size > (mp_int)((MAXINT - sizeof *hm - 0x100000) / sizeof *mcp)
|
|
|| !(hm = xalloc(sizeof *hm + sizeof *mcp * hash_size) ) )
|
|
{
|
|
return NULL;
|
|
}
|
|
|
|
hm->mask = hash_size;
|
|
hm->used = hm->cond_deleted = hm->ref = 0;
|
|
hm->last_used = current_time;
|
|
|
|
/* These members don't really need a default initialisation
|
|
* but it's here to catch bogies.
|
|
*/
|
|
hm->deleted = NULL;
|
|
|
|
/* Initialise the hashbuckets (there is at least one) */
|
|
mcp = hm->chains;
|
|
do *mcp++ = NULL; while (--hash_size >= 0);
|
|
|
|
LOG_ALLOC("get_new_hash", SIZEOF_MH(hm), sizeof *hm + sizeof *mcp * hm->mask);
|
|
m->user->mapping_total += SIZEOF_MH(hm);
|
|
|
|
return hm;
|
|
} /* get_new_hash() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
static mapping_t *
|
|
get_new_mapping ( wiz_list_t * user, mp_int num_values
|
|
, mp_int hash_size, mp_int cond_size)
|
|
|
|
/* Allocate a basic mapping with <num_values> values per key, and set it
|
|
* up to have an initial datablock of <data_size> entries, a hash
|
|
* suitable for <hash_size> entries, and a condensed block for <cond_size>
|
|
* entries.
|
|
*
|
|
* The .user is of the mapping is set to <user>.
|
|
*
|
|
* Return the new mapping, or NULL when out of memory.
|
|
*/
|
|
/* TODO: hash_size of mp_int seems unnecessarily large to me, because
|
|
* TODO::mappings can only have p_int values? */
|
|
{
|
|
mapping_cond_t *cm;
|
|
mapping_hash_t *hm;
|
|
mapping_t *m;
|
|
/* DEBUG: */ size_t cm_size;
|
|
|
|
/* Check if the new size is too big */
|
|
if (num_values > 0)
|
|
{
|
|
if (num_values > SSIZE_MAX /* TODO: SIZET_MAX, see port.h */
|
|
|| ( num_values != 0
|
|
&& (SSIZE_MAX - sizeof(map_chain_t)) / num_values < sizeof(svalue_t))
|
|
)
|
|
return NULL;
|
|
}
|
|
|
|
/* Allocate the structures */
|
|
m = xalloc(sizeof *m);
|
|
if (!m)
|
|
return NULL;
|
|
|
|
m->user = user; /* Already needed for statistics */
|
|
|
|
/* Set up the key block for <cond_size> entries */
|
|
|
|
cm = NULL;
|
|
if (cond_size > 0)
|
|
{
|
|
|
|
/* !DEBUG: size_t */ cm_size = (size_t)cond_size;
|
|
cm = xalloc(sizeof(*cm) + sizeof(svalue_t) * cm_size * (num_values+1) - 1);
|
|
if (!cm)
|
|
{
|
|
xfree(m);
|
|
return NULL;
|
|
}
|
|
|
|
cm->size = cm_size;
|
|
}
|
|
|
|
/* Set up the hash block for <hash_size> entries.
|
|
* Do this last because get_new_hash() modifies the statistics.
|
|
*/
|
|
|
|
hm = NULL;
|
|
if (hash_size > 0)
|
|
{
|
|
hm = get_new_hash(m, hash_size);
|
|
if (!hm)
|
|
{
|
|
if (cm) xfree(cm);
|
|
xfree(m);
|
|
return NULL;
|
|
}
|
|
}
|
|
|
|
/* Initialise the mapping */
|
|
|
|
m->cond = cm;
|
|
m->hash = hm;
|
|
m->next = NULL;
|
|
m->num_values = num_values;
|
|
m->num_entries = 0;
|
|
m->ref = 1;
|
|
|
|
/* Statistics */
|
|
LOG_ADD("get_new_mapping - base", sizeof *m);
|
|
m->user->mapping_total += sizeof *m;
|
|
if (cm)
|
|
{
|
|
LOG_ALLOC("get_new_mapping - cond", SIZEOF_MC(cm, num_values), sizeof(*cm) + sizeof(svalue_t) * cm_size * (num_values+1) - 1);
|
|
m->user->mapping_total += SIZEOF_MC(cm, num_values);
|
|
}
|
|
/* hm has already been counted */
|
|
|
|
num_mappings++;
|
|
if (m->cond && m->hash)
|
|
num_dirty_mappings++;
|
|
else if (m->hash)
|
|
num_hash_mappings++;
|
|
check_total_mapping_size();
|
|
|
|
return m;
|
|
|
|
} /* get_new_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
mapping_t *
|
|
allocate_mapping (mp_int size, mp_int num_values)
|
|
|
|
/* Allocate a mapping with <num_values> values per key, and setup the
|
|
* hash part for (initially) <size> entries. The condensed part will
|
|
* not be allocated.
|
|
*
|
|
* Return the new mapping, or NULL when out of memory.
|
|
*/
|
|
|
|
{
|
|
return get_new_mapping(current_object->user, num_values, size, 0);
|
|
} /* allocate_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
mapping_t *
|
|
allocate_cond_mapping (wiz_list_t * user, mp_int size, mp_int num_values)
|
|
|
|
/* Allocate for <user> a mapping with <num_values> values per key, and
|
|
* setup the condensed part for <size> entries. The hash part will not be
|
|
* allocated.
|
|
*
|
|
* The swapper uses this function.
|
|
*
|
|
* Return the new mapping, or NULL when out of memory.
|
|
*/
|
|
|
|
{
|
|
return get_new_mapping(user, num_values, 0, size);
|
|
} /* allocate_cond_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
Bool
|
|
_free_mapping (mapping_t *m, Bool no_data)
|
|
|
|
/* Aliases: free_mapping(m) -> _free_mapping(m, FALSE)
|
|
* free_empty_mapping(m) -> _free_mapping(m, TRUE)
|
|
*
|
|
* The mapping and all associated memory is deallocated resp. dereferenced.
|
|
* Always return TRUE (for use within the free_mapping() macro).
|
|
*
|
|
* If <no_data> is TRUE, all the svalues are assumed to be freed already
|
|
* (the swapper uses this after swapping out a mapping). The function still
|
|
* will deallocate any map_chain entries, if existing.
|
|
*
|
|
* If the mapping is 'dirty' (ie. contains a hash_mapping part), it
|
|
* is not deallocated immediately, but instead counts 1 to the empty_mapping-
|
|
* _load (with regard to the threshold).
|
|
*/
|
|
|
|
{
|
|
mapping_hash_t *hm; /* Hashed part of <m> */
|
|
|
|
#ifdef DEBUG
|
|
if (!m)
|
|
fatal("NULL pointer passed to free_mapping().\n");
|
|
|
|
if (!m->user)
|
|
fatal("No wizlist pointer for mapping");
|
|
|
|
if (!no_data && m->ref > 0)
|
|
fatal("Mapping with %"PRIdPINT" refs passed to _free_mapping().\n",
|
|
m->ref);
|
|
#endif
|
|
|
|
num_mappings--;
|
|
if (m->cond && m->hash)
|
|
num_dirty_mappings--;
|
|
else if (m->hash)
|
|
num_hash_mappings--;
|
|
|
|
m->ref = 0;
|
|
/* In case of free_empty_mapping(), this is neither guaranteed nor a
|
|
* precondition, but in case this mapping needs to be entered into the
|
|
* dirty list the refcount needs to be correct.
|
|
*/
|
|
|
|
/* Free the condensed data */
|
|
if (m->cond != NULL)
|
|
{
|
|
p_int left = m->cond->size * (m->num_values + 1);
|
|
svalue_t *data = &(m->cond->data[0]);
|
|
|
|
for (; !no_data && left > 0; left--, data++)
|
|
free_svalue(data);
|
|
|
|
LOG_SUB("free_mapping cond", SIZEOF_MC(m->cond, m->num_values));
|
|
m->user->mapping_total -= SIZEOF_MC(m->cond, m->num_values);
|
|
check_total_mapping_size();
|
|
xfree(m->cond);
|
|
m->cond = NULL;
|
|
|
|
}
|
|
|
|
/* Free the hashed data */
|
|
if ( NULL != (hm = m->hash) )
|
|
{
|
|
map_chain_t **mcp, *mc, *next;
|
|
p_int i;
|
|
|
|
#ifdef DEBUG
|
|
if (hm->ref)
|
|
fatal("Ref count in freed hash mapping: %"PRIdPINT"\n", hm->ref);
|
|
#endif
|
|
LOG_SUB("free_mapping hash", SIZEOF_MH(hm));
|
|
m->user->mapping_total -= SIZEOF_MH(hm);
|
|
check_total_mapping_size();
|
|
|
|
mcp = hm->chains;
|
|
|
|
/* Loop through all chains */
|
|
|
|
i = hm->mask + 1;
|
|
do {
|
|
|
|
/* Free this chain */
|
|
|
|
for (next = *mcp++; NULL != (mc = next); )
|
|
{
|
|
next = mc->next;
|
|
free_map_chain(m, mc, no_data);
|
|
}
|
|
} while (--i);
|
|
|
|
xfree(hm);
|
|
}
|
|
|
|
/* Free the base structure.
|
|
*/
|
|
|
|
LOG_SUB("free_mapping base", sizeof(*m));
|
|
m->user->mapping_total -= sizeof(*m);
|
|
check_total_mapping_size();
|
|
xfree(m);
|
|
|
|
return MY_TRUE;
|
|
} /* _free_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
void
|
|
free_protector_mapping (mapping_t *m)
|
|
|
|
/* Free the mapping <m> which is part of a T_PROTECTOR_MAPPING svalue.
|
|
* Such svalues are created only for mappings with a hashed part, and
|
|
* have the ref of the hashed part incremented at creation.
|
|
*
|
|
* This function is a wrapper around free_mapping() and takes care
|
|
* to free m->hash->deleted if m->hash->ref reaches zero due to this
|
|
* call.
|
|
*/
|
|
|
|
{
|
|
mapping_hash_t *hm;
|
|
|
|
#ifdef DEBUG
|
|
/* This type of mapping must have a hash part */
|
|
|
|
if (!m->hash || m->hash->ref <= 0)
|
|
{
|
|
/* This shouldn't happen */
|
|
printf("%s free_protector_mapping() : no hash %s\n"
|
|
, time_stamp(), m->hash ? "reference" : "part");
|
|
#ifdef TRACE_CODE
|
|
{
|
|
last_instructions(TOTAL_TRACE_LENGTH, MY_TRUE, NULL);
|
|
}
|
|
#endif
|
|
dump_trace(MY_FALSE, NULL);
|
|
/* printf("%s free_protector_mapping() : no hash %s\n"
|
|
, time_stamp(), m->hash ? "reference" : "part");
|
|
*/
|
|
free_mapping(m);
|
|
}
|
|
#endif /* DEBUG */
|
|
|
|
|
|
/* If this was the last protective reference, execute
|
|
* the pending deletions.
|
|
*/
|
|
|
|
if (!--(hm = m->hash)->ref)
|
|
{
|
|
map_chain_t *mc, *next;
|
|
|
|
for (mc = hm->deleted; mc; mc = next)
|
|
{
|
|
next = mc->next;
|
|
free_map_chain(m, mc, MY_FALSE);
|
|
}
|
|
|
|
hm->deleted = NULL;
|
|
}
|
|
|
|
/* Call free_mapping() if appropriate */
|
|
|
|
free_mapping(m);
|
|
|
|
} /* free_protector_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
static INLINE mp_int
|
|
mhash (svalue_t * svp)
|
|
|
|
/* Compute and return the hash value for svalue *<svp>.
|
|
* The function requires that x.generic is valid even for types without
|
|
* a secondary type information.
|
|
*/
|
|
|
|
{
|
|
mp_int i;
|
|
|
|
switch (svp->type)
|
|
{
|
|
case T_STRING:
|
|
i = mstr_get_hash(svp->u.str);
|
|
break;
|
|
|
|
case T_CLOSURE:
|
|
if (CLOSURE_REFERENCES_CODE(svp->x.closure_type))
|
|
{
|
|
i = (p_int)(svp->u.lambda) ^ *SVALUE_FULLTYPE(svp);
|
|
}
|
|
else if (CLOSURE_MALLOCED(svp->x.closure_type))
|
|
{
|
|
i = (p_int)(svp->u.lambda->ob) ^ *SVALUE_FULLTYPE(svp);
|
|
}
|
|
else /* Efun, Simul-Efun, Operator closure */
|
|
{
|
|
i = *SVALUE_FULLTYPE(svp);
|
|
}
|
|
break;
|
|
|
|
default:
|
|
i = svp->u.number ^ *SVALUE_FULLTYPE(svp);
|
|
break;
|
|
}
|
|
|
|
i = i ^ i >> 16;
|
|
i = i ^ i >> 8;
|
|
|
|
return i;
|
|
} /* mhash() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
static svalue_t *
|
|
find_map_entry ( mapping_t *m, svalue_t *map_index
|
|
, p_int * pKeys, map_chain_t ** ppChain
|
|
, Bool bMakeTabled
|
|
)
|
|
|
|
/* Index mapping <m> with key value <map_index> and if found, return a pointer
|
|
* to the entry block for this key (ie. the result pointer will point to
|
|
* the stored key value).
|
|
* If the key was found in the condensed data, *<pKeys> will be set
|
|
* to key index; otherwise *<ppChain> will point to the hash map chain entry.
|
|
* The 'not found' values for the two variables are -1 and NULL resp.
|
|
*
|
|
* If <bMakeTabled> is TRUE and <map_index> is a string, it is made tabled.
|
|
*
|
|
* If the key is not found, NULL is returned.
|
|
*
|
|
* Sideeffect: <map_index>.x.generic information is generated for types
|
|
* which usually have none (required for hashing).
|
|
*/
|
|
|
|
{
|
|
*pKeys = -1;
|
|
*ppChain = NULL;
|
|
|
|
/* If the key is a string, make it tabled */
|
|
if (map_index->type == T_STRING && !mstr_tabled(map_index->u.str)
|
|
&& bMakeTabled)
|
|
{
|
|
map_index->u.str = make_tabled(map_index->u.str);
|
|
}
|
|
|
|
/* Generate secondary information for types which usually
|
|
* have none (required for hashing).
|
|
*/
|
|
if (map_index->type != T_CLOSURE
|
|
&& map_index->type != T_FLOAT
|
|
&& map_index->type != T_SYMBOL
|
|
&& map_index->type != T_QUOTED_ARRAY
|
|
)
|
|
map_index->x.generic = (short)(map_index->u.number << 1);
|
|
|
|
/* Search in the condensed part first.
|
|
*/
|
|
|
|
if (m->cond && m->cond->size != 0)
|
|
{
|
|
mapping_cond_t *cm = m->cond;
|
|
mp_int size = cm->size;
|
|
svalue_t *key, * keystart, * keyend;
|
|
|
|
keystart = &cm->data[0];
|
|
keyend = keystart + size;
|
|
|
|
/* Skip eventual deleted entries at start or end */
|
|
while (size > 0 && keystart->type == T_INVALID)
|
|
{
|
|
keystart++;
|
|
size--;
|
|
}
|
|
|
|
while (size > 0 && keyend[-1].type == T_INVALID)
|
|
{
|
|
keyend--;
|
|
size--;
|
|
}
|
|
|
|
while (keyend > keystart)
|
|
{
|
|
int cmp;
|
|
|
|
key = (keyend - keystart) / 2 + keystart;
|
|
|
|
while (key > keystart && key->type == T_INVALID)
|
|
key--;
|
|
|
|
cmp = svalue_cmp(map_index, key);
|
|
|
|
if (cmp == 0)
|
|
{
|
|
/* Found it */
|
|
*pKeys = (p_int)(key - &(cm->data[0]));
|
|
return key;
|
|
}
|
|
|
|
if (cmp > 0)
|
|
{
|
|
/* The map_index value is after key */
|
|
for ( keystart = key+1
|
|
; keystart < keyend && keystart->type == T_INVALID
|
|
; keystart++)
|
|
NOOP;
|
|
}
|
|
else
|
|
{
|
|
/* The map_index value is before key */
|
|
for ( keyend = key
|
|
; keystart < keyend && keyend[-1].type == T_INVALID
|
|
; keyend--)
|
|
NOOP;
|
|
}
|
|
}
|
|
}
|
|
|
|
/* At this point, the key was not found in the condensed index
|
|
* of the mapping. Try the hashed index next.
|
|
*/
|
|
|
|
if (m->hash && m->hash->used)
|
|
{
|
|
mapping_hash_t *hm = m->hash;
|
|
map_chain_t *mc;
|
|
|
|
mp_int idx = mhash(map_index) & hm->mask;
|
|
|
|
/* Look for the value in the chain determined by index */
|
|
|
|
for (mc = hm->chains[idx]; mc != NULL; mc = mc->next)
|
|
{
|
|
if (!svalue_eq(&(mc->data[0]), map_index))
|
|
{
|
|
/* Found it */
|
|
*ppChain = mc;
|
|
return &(mc->data[0]);
|
|
}
|
|
}
|
|
}
|
|
|
|
/* Not found at all */
|
|
|
|
return NULL;
|
|
} /* find_map_entry() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
_get_map_lvalue (mapping_t *m, svalue_t *map_index
|
|
, Bool need_lvalue, Bool check_size)
|
|
|
|
/* Index mapping <m> with key value <map_index> and return a pointer to the
|
|
* array of values stored for this key. If the mapping has no values for a
|
|
* key, a pointer to const1 is returned.
|
|
*
|
|
* If the mapping does not contains the given index, and <need_lvalue> is
|
|
* false, &const0 is returned. If <need_lvalue> is true, a new key/value
|
|
* entry is created and returned (map_index is assigned for this). If the
|
|
* mapping doesn't have values for a key, a pointer to a local static
|
|
* instance of svalue-0 is returned.
|
|
*
|
|
* If check_size is true and the extension of the mapping would increase
|
|
* its size over max_mapping_size, a runtime error is raised.
|
|
*
|
|
* Return NULL when out of memory.
|
|
*
|
|
* Sideeffect: if <map_index> is an unshared string, it is made shared.
|
|
* Also, <map_index>.x.generic information is generated for types
|
|
* which usually have none (required for hashing).
|
|
*
|
|
* For easier use, mapping.h defines the following macros:
|
|
* get_map_value(m,x) -> _get_map_lvalue(m,x,false,true)
|
|
* get_map_lvalue(m,x) -> _get_map_lvalue(m,x,true,true)
|
|
* get_map_lvalue_unchecked(m,x) -> _get_map_lvalue(m,x,true,false)
|
|
*/
|
|
|
|
{
|
|
map_chain_t * mc;
|
|
mapping_hash_t * hm;
|
|
svalue_t * entry;
|
|
mp_int idx;
|
|
|
|
static svalue_t local_const0;
|
|
/* Local svalue-0 instance to be returned if a lvalue
|
|
* for a 0-width was requested.
|
|
*/
|
|
|
|
entry = find_map_entry(m, map_index, (p_int *)&idx, &mc, need_lvalue);
|
|
|
|
/* If we found the entry, return the values */
|
|
if (entry != NULL)
|
|
{
|
|
if (!m->num_values)
|
|
return &const1;
|
|
|
|
if (mc != NULL)
|
|
return entry+1;
|
|
|
|
return COND_DATA(m->cond, idx, m->num_values);
|
|
}
|
|
|
|
if (!need_lvalue)
|
|
return &const0;
|
|
|
|
/* We didn't find key and the caller wants the data.
|
|
* So create a new entry and enter it into the hash index (also
|
|
* created if necessary).
|
|
*/
|
|
|
|
/* Size limit exceeded? */
|
|
if (check_size && (max_mapping_size || max_mapping_keys))
|
|
{
|
|
mp_int msize;
|
|
|
|
msize = (mp_int)MAP_TOTAL_SIZE(m) + m->num_values + 1;
|
|
if ( (max_mapping_size && msize > (mp_int)max_mapping_size)
|
|
|| (max_mapping_keys && MAP_SIZE(m)+1 > max_mapping_keys)
|
|
)
|
|
{
|
|
check_map_for_destr(m);
|
|
msize = (mp_int)MAP_TOTAL_SIZE(m) + m->num_values + 1;
|
|
}
|
|
if (max_mapping_size && msize > (mp_int)max_mapping_size)
|
|
{
|
|
errorf("Illegal mapping size: %"PRIdMPINT" elements (%"
|
|
PRIdPINT" x %"PRIdPINT")\n"
|
|
, msize, MAP_SIZE(m)+1, m->num_values);
|
|
return NULL;
|
|
}
|
|
if (max_mapping_keys && MAP_SIZE(m) > (mp_int)max_mapping_keys)
|
|
{
|
|
errorf("Illegal mapping size: %"PRIdMPINT" entries\n", msize+1);
|
|
return NULL;
|
|
}
|
|
}
|
|
|
|
/* Get the new entry svalues, but don't assign the key value
|
|
* yet - further steps might still fail.
|
|
*/
|
|
mc = new_map_chain(m);
|
|
if (NULL == mc)
|
|
return NULL;
|
|
|
|
/* If the mapping has no hashed index, create one with just one
|
|
* chain and put the new entry in there.
|
|
*/
|
|
|
|
if ( !(hm = m->hash) )
|
|
{
|
|
/* Create the hash part of the mapping and put
|
|
* it into the dirty list.
|
|
*/
|
|
|
|
hm = get_new_hash(m, 1);
|
|
if (!hm)
|
|
{
|
|
free_map_chain(m, mc, MY_TRUE);
|
|
return NULL; /* Oops */
|
|
}
|
|
m->hash = hm;
|
|
|
|
/* Now insert the map_chain structure into its chain */
|
|
hm->chains[0] = mc;
|
|
mc->next = NULL;
|
|
|
|
if (m->cond)
|
|
num_dirty_mappings++;
|
|
else
|
|
num_hash_mappings++;
|
|
}
|
|
else
|
|
{
|
|
|
|
/* The hashed index exists, so we can insert the new entry there.
|
|
*
|
|
* However, if the average number of map_chains per chain exceeds 2,
|
|
* double the size of the bucket array first.
|
|
*/
|
|
if (hm->used & ~hm->mask<<1)
|
|
{
|
|
mapping_hash_t *hm2;
|
|
mp_int size, mask, j;
|
|
map_chain_t **mcp, **mcp2, *next;
|
|
|
|
hm2 = hm;
|
|
|
|
/* Compute new size and mask, and allocate the structure */
|
|
|
|
size = (hm->mask << 1) + 2;
|
|
mask = size - 1;
|
|
|
|
hm = xalloc(sizeof *hm - sizeof *mcp + sizeof *mcp * size);
|
|
if (!hm)
|
|
{
|
|
free_map_chain(m, mc, MY_TRUE);
|
|
return NULL;
|
|
}
|
|
|
|
/* Initialise the new structure except for the chains */
|
|
|
|
*hm = *hm2;
|
|
hm->mask = mask;
|
|
mcp = hm->chains;
|
|
do *mcp++ = NULL; while (--size);
|
|
|
|
/* Copy the old chains into the new buckets by rehashing
|
|
* them.
|
|
*/
|
|
mcp = hm->chains;
|
|
mcp2 = hm2->chains;
|
|
for (j = hm2->mask + 1; --j >= 0; )
|
|
{
|
|
map_chain_t *mc2;
|
|
|
|
for (mc2 = *mcp2++; mc2; mc2 = next)
|
|
{
|
|
next = mc2->next;
|
|
idx = mhash(&(mc2->data[0])) & mask;
|
|
mc2->next = mcp[idx];
|
|
mcp[idx] = mc2;
|
|
}
|
|
}
|
|
m->hash = hm;
|
|
|
|
LOG_ALLOC("get_map_lvalue - existing hash", SIZEOF_MH(hm) - SIZEOF_MH(hm2), sizeof *hm - sizeof *mcp + sizeof *mcp * size);
|
|
m->user->mapping_total += SIZEOF_MH(hm) - SIZEOF_MH(hm2);
|
|
check_total_mapping_size();
|
|
|
|
/* Away, old data! */
|
|
|
|
xfree(hm2);
|
|
}
|
|
|
|
/* Finally, insert the new entry into its chain */
|
|
|
|
idx = mhash(map_index) & hm->mask;
|
|
mc->next = hm->chains[idx];
|
|
hm->chains[idx] = mc;
|
|
}
|
|
|
|
/* With the new map_chain structure inserted, we can adjust
|
|
* the statistics and copy the key value into the structure.
|
|
*/
|
|
|
|
assign_svalue_no_free(&(mc->data[0]), map_index);
|
|
for (idx = m->num_values, entry = &(mc->data[1]); idx > 0
|
|
; idx--, entry++)
|
|
put_number(entry, 0);
|
|
|
|
hm->last_used = current_time;
|
|
hm->used++;
|
|
m->num_entries++;
|
|
|
|
if (m->num_values)
|
|
return &(mc->data[1]);
|
|
|
|
/* Return a reference to the local static svalue-0 instance, so that
|
|
* buggy code doesn't accidentally changes the global const0.
|
|
*/
|
|
put_number(&local_const0, 0);
|
|
return &local_const0;
|
|
} /* _get_map_lvalue() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
Bool
|
|
mapping_references_objects (mapping_t *m)
|
|
|
|
/* Check if the mapping <m> references objects (directly or through
|
|
* closures) as keys.
|
|
* Return TRUE if it does, FALSE if it doesn't.
|
|
*
|
|
* The swapper uses this function to determine whether or not to
|
|
* swap a mapping.
|
|
*/
|
|
|
|
{
|
|
mapping_cond_t *cm;
|
|
mapping_hash_t *hm;
|
|
|
|
/* Scan the condensed part for object references used as keys.
|
|
*/
|
|
|
|
if (NULL != (cm = m->cond))
|
|
{
|
|
size_t ix;
|
|
svalue_t * entry;
|
|
|
|
for (ix = 0, entry = &(cm->data[0]); ix < cm->size; ++ix, ++entry)
|
|
{
|
|
if (T_OBJECT == entry->type || T_CLOSURE == entry->type)
|
|
return MY_TRUE;
|
|
} /* for (all keys) */
|
|
|
|
} /* if (m->cond) */
|
|
|
|
/* If it exists, scan the hash part for object references.
|
|
*/
|
|
|
|
if ( NULL != (hm = m->hash) )
|
|
{
|
|
map_chain_t **mcp, *mc;
|
|
p_int i;
|
|
|
|
/* Walk all chains */
|
|
|
|
for (mcp = hm->chains, i = hm->mask + 1; --i >= 0;)
|
|
{
|
|
/* Walk this chain */
|
|
|
|
for (mc = *mcp++; NULL != mc; mc = mc->next)
|
|
{
|
|
svalue_t * entry = &(mc->data[0]);
|
|
|
|
if (T_OBJECT == entry->type || T_CLOSURE == entry->type)
|
|
return MY_TRUE;
|
|
} /* walk this chain */
|
|
} /* walk all chains */
|
|
} /* if (hash part exists) */
|
|
|
|
return MY_FALSE;
|
|
} /* mapping_references_objects() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
void
|
|
check_map_for_destr (mapping_t *m)
|
|
|
|
/* Check the mapping <m> for references to destructed objects.
|
|
* Where they appear as keys, both key and associated values are
|
|
* deleted from the mapping. Where they appear as values, they are
|
|
* replaced by svalue-0.
|
|
*/
|
|
|
|
{
|
|
p_int num_values;
|
|
mapping_cond_t *cm;
|
|
mapping_hash_t *hm;
|
|
|
|
num_values = m->num_values;
|
|
|
|
/* Scan the condensed part for destructed object references used as keys.
|
|
*/
|
|
|
|
if (NULL != (cm = m->cond))
|
|
{
|
|
size_t ix;
|
|
svalue_t * entry;
|
|
|
|
/* First, scan the keys */
|
|
for (ix = 0, entry = &(cm->data[0]); ix < cm->size; ++ix, ++entry)
|
|
{
|
|
if (T_INVALID == entry->type)
|
|
continue;
|
|
|
|
if (destructed_object_ref(entry))
|
|
{
|
|
p_int i;
|
|
svalue_t * data = COND_DATA(cm, ix, num_values);
|
|
|
|
/* Destructed key: remove the whole entry */
|
|
m->num_entries--;
|
|
|
|
free_svalue(entry);
|
|
entry->type = T_INVALID;
|
|
|
|
for (i = num_values; i > 0; --i, data++)
|
|
{
|
|
free_svalue(data);
|
|
put_number(data, 0);
|
|
}
|
|
|
|
/* Count the deleted entry in the hash part.
|
|
* Create it if necessary.
|
|
*/
|
|
if ( !(hm = m->hash) )
|
|
{
|
|
hm = get_new_hash(m, 0);
|
|
if (!hm)
|
|
{
|
|
outofmem(sizeof *hm, "hash mapping");
|
|
/* NOTREACHED */
|
|
return;
|
|
}
|
|
m->hash = hm;
|
|
num_dirty_mappings++;
|
|
}
|
|
|
|
hm->cond_deleted++;
|
|
|
|
continue;
|
|
}
|
|
} /* for (all keys) */
|
|
|
|
/* Second, scan the values */
|
|
for ( ix = 0, entry = &(cm->data[cm->size])
|
|
; ix < num_values * cm->size; ++ix, ++entry)
|
|
{
|
|
if (destructed_object_ref(entry))
|
|
{
|
|
assign_svalue(entry, &const0);
|
|
}
|
|
} /* for (all values) */
|
|
} /* if (m->cond) */
|
|
|
|
/* If it exists, scan the hash part for destructed objects.
|
|
*/
|
|
|
|
if ( NULL != (hm = m->hash) )
|
|
{
|
|
map_chain_t **mcp, **mcp2, *mc;
|
|
p_int i, j;
|
|
|
|
/* Walk all chains */
|
|
|
|
for (mcp = hm->chains, i = hm->mask + 1; --i >= 0;)
|
|
{
|
|
/* Walk this chain */
|
|
|
|
for (mcp2 = mcp++; NULL != (mc = *mcp2); )
|
|
{
|
|
/* Destructed object as key: remove entry */
|
|
|
|
svalue_t * entry = &(mc->data[0]);
|
|
|
|
if (destructed_object_ref(entry))
|
|
{
|
|
m->num_entries--;
|
|
|
|
*mcp2 = mc->next;
|
|
|
|
/* If the mapping is a protector mapping, move
|
|
* the entry into the 'deleted' list, else
|
|
* just deallocate it.
|
|
*/
|
|
if (hm->ref)
|
|
{
|
|
mc->next = hm->deleted;
|
|
hm->deleted = mc;
|
|
}
|
|
else
|
|
{
|
|
free_map_chain(m, mc, MY_FALSE);
|
|
}
|
|
hm->used--;
|
|
continue;
|
|
}
|
|
|
|
/* Scan the values of this entry (not reached
|
|
* if the entry was removed above
|
|
*/
|
|
for (entry++, j = num_values; j > 0; --j, ++entry)
|
|
{
|
|
if (destructed_object_ref(entry))
|
|
{
|
|
assign_svalue(entry, &const0);
|
|
}
|
|
}
|
|
|
|
mcp2 = &mc->next;
|
|
|
|
} /* walk this chain */
|
|
} /* walk all chains */
|
|
} /* if (hash part exists) */
|
|
|
|
} /* check_map_for_destr() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
static void
|
|
remove_mapping (mapping_t *m, svalue_t *map_index)
|
|
|
|
/* Remove from mapping <m> that entry which is index by key value
|
|
* <map_index>. Nothing happens if it doesn't exist.
|
|
*
|
|
* Sideeffect: if <map_index> is an unshared string, it is made shared.
|
|
* Also, <map_index>.x.generic information is generated for types
|
|
* which usually have none (required for hashing).
|
|
*/
|
|
|
|
{
|
|
p_int key_ix;
|
|
svalue_t * entry;
|
|
map_chain_t * mc;
|
|
mapping_hash_t * hm;
|
|
p_int num_values;
|
|
|
|
num_values = m->num_values;
|
|
|
|
entry = find_map_entry(m, map_index, &key_ix, &mc, MY_FALSE);
|
|
|
|
if (NULL != entry)
|
|
{
|
|
/* The entry exists - now remove it */
|
|
|
|
m->num_entries--;
|
|
|
|
if (key_ix >= 0)
|
|
{
|
|
/* The entry is in the condensed part */
|
|
p_int i;
|
|
|
|
free_svalue(entry); entry->type = T_INVALID;
|
|
entry = COND_DATA(m->cond, key_ix, num_values);
|
|
for (i = num_values; i > 0; i--, entry++)
|
|
{
|
|
free_svalue(entry);
|
|
put_number(entry, 0);
|
|
}
|
|
|
|
/* Count the deleted entry in the hash part.
|
|
* Create it if necessary.
|
|
*/
|
|
if ( !(hm = m->hash) )
|
|
{
|
|
hm = get_new_hash(m, 0);
|
|
if (!hm)
|
|
{
|
|
outofmem(sizeof *hm, "hash mapping");
|
|
/* NOTREACHED */
|
|
return;
|
|
}
|
|
m->hash = hm;
|
|
|
|
if (m->cond)
|
|
num_dirty_mappings++;
|
|
else
|
|
num_hash_mappings++;
|
|
}
|
|
|
|
hm->last_used = current_time;
|
|
hm->cond_deleted++;
|
|
}
|
|
else if (mc != NULL && NULL != (hm = m->hash))
|
|
{
|
|
/* The key is in the hash mapping */
|
|
|
|
map_chain_t *prev, *mc2;
|
|
mp_int idx = mhash(entry) & hm->mask;
|
|
|
|
for ( prev = 0, mc2 = hm->chains[idx]
|
|
; mc2 != NULL && mc2 != mc
|
|
; prev = mc2, mc2 = mc2->next)
|
|
NOOP;
|
|
|
|
if (mc2 == NULL)
|
|
fatal("Mapping entry didn't hash to the same spot.\n");
|
|
|
|
/* Unlink the found entry */
|
|
if (prev)
|
|
prev->next = mc->next;
|
|
else
|
|
hm->chains[idx] = mc->next;
|
|
|
|
/* If the mapping is a protector mapping, move
|
|
* the entry into the 'deleted' list, else
|
|
* just deallocate it.
|
|
*/
|
|
if (hm->ref)
|
|
{
|
|
mc->next = hm->deleted;
|
|
hm->deleted = mc;
|
|
}
|
|
else
|
|
{
|
|
free_map_chain(m, mc, MY_FALSE);
|
|
}
|
|
|
|
hm->last_used = current_time;
|
|
hm->used--;
|
|
/* TODO: Reduce the size of the hashtable if the average
|
|
* TODO:: number of entries per chain is <= 1 (or better <= 0.5
|
|
* TODO:: to provide some breathing space for new entries).
|
|
*/
|
|
}
|
|
else
|
|
fatal("Mapping entry found in neither condensed nor hash index.\n");
|
|
}
|
|
/* else the entry wasn't found */
|
|
|
|
} /* remove_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
mapping_t *
|
|
resize_mapping (mapping_t *m, mp_int new_width)
|
|
|
|
/* Produce a shallow copy of mapping <m>, adjusted to have
|
|
* <new_width> values per key, and return it.
|
|
* The copy of a protector mapping is a normal mapping.
|
|
*
|
|
* check_map_for_destr(m) should be called before.
|
|
*/
|
|
|
|
{
|
|
mapping_t * m2;
|
|
mapping_hash_t * hm, *hm2 = NULL;
|
|
mapping_cond_t * cm, *cm2 = NULL;
|
|
mp_int common_width; /* == min(num_values, new_width) */
|
|
p_int num_entries;
|
|
|
|
/* Set the width variables */
|
|
if (m->num_values >= new_width)
|
|
{
|
|
common_width = new_width;
|
|
}
|
|
else
|
|
{
|
|
common_width = m->num_values;
|
|
}
|
|
|
|
/* Check if the new size is too big */
|
|
if (new_width > 0)
|
|
{
|
|
if (new_width > SSIZE_MAX /* TODO: SIZET_MAX, see port.h */
|
|
|| ( new_width != 0
|
|
&& (SSIZE_MAX - sizeof(map_chain_t)) / new_width < sizeof(svalue_t))
|
|
)
|
|
{
|
|
errorf("Mapping width too big (%"PRIdMPINT")\n", new_width);
|
|
/* NOTREACHED */
|
|
return NULL;
|
|
}
|
|
|
|
}
|
|
|
|
num_entries = m->num_entries;
|
|
|
|
/* Get the target mapping without a hash, but with a condensed block
|
|
* big enough to hold all entries.
|
|
*/
|
|
{
|
|
p_int cm_size = 0;
|
|
if (m->cond)
|
|
{
|
|
cm_size = m->cond->size;
|
|
if (m->hash)
|
|
cm_size -= m->hash->cond_deleted;
|
|
}
|
|
m2 = get_new_mapping(current_object->user, new_width, 0, cm_size);
|
|
if (!m2)
|
|
{
|
|
outofmem(sizeof *m2 + (mp_int)sizeof(svalue_t) * m->num_entries * new_width
|
|
, "result mapping base structure");
|
|
/* NOTREACHED */
|
|
return NULL;
|
|
}
|
|
}
|
|
|
|
/* --- Copy the hash part, if existent ---
|
|
*/
|
|
|
|
if ( NULL != (hm = m->hash) )
|
|
{
|
|
map_chain_t **mcp, **mcp2;
|
|
mp_int size;
|
|
|
|
/* Allocate and initialize the hash structure */
|
|
|
|
size = hm->mask + 1;
|
|
hm2 = xalloc(sizeof *hm - sizeof *mcp + sizeof *mcp * size);
|
|
if (!hm2)
|
|
{
|
|
outofmem(sizeof *hm - sizeof *mcp + sizeof *mcp * size, "hash structure");
|
|
/* NOTREACHED */
|
|
return NULL;
|
|
}
|
|
|
|
hm2->mask = hm->mask;
|
|
hm2->used = hm->used;
|
|
hm2->last_used = current_time;
|
|
hm2->cond_deleted = 0;
|
|
hm2->deleted = NULL;
|
|
hm2->ref = 0;
|
|
|
|
/* Now copy the hash chains */
|
|
|
|
mcp = hm->chains;
|
|
mcp2 = hm2->chains;
|
|
do {
|
|
map_chain_t *last = NULL, *mc, *mc2;
|
|
|
|
for (mc = *mcp++; mc; mc = mc->next)
|
|
if(destructed_object_ref(&(mc->data[0])))
|
|
num_entries--;
|
|
else
|
|
{
|
|
svalue_t *src, *dest;
|
|
p_int i;
|
|
|
|
mc2 = new_map_chain(m2);
|
|
if (!mc2)
|
|
{
|
|
xfree(hm2);
|
|
outofmem(SIZEOF_MCH(mc, new_width), "hash link");
|
|
/* NOTREACHED */
|
|
return NULL;
|
|
}
|
|
|
|
/* Copy the key and the common values */
|
|
for (src = &(mc->data[0]), dest = &(mc2->data[0]), i = common_width
|
|
; i >= 0
|
|
; --i, src++, dest++)
|
|
{
|
|
assign_svalue_no_free(dest, src);
|
|
}
|
|
|
|
/* Zero out any extraneous values */
|
|
for (dest = &(mc2->data[common_width+1]), i = new_width - common_width
|
|
; i > 0
|
|
; --i, dest++)
|
|
{
|
|
put_number(dest, 0);
|
|
}
|
|
|
|
|
|
mc2->next = last;
|
|
last = mc2;
|
|
}
|
|
*mcp2++ = last;
|
|
} while (--size);
|
|
|
|
/* Plug the new hash into the new mapping */
|
|
m2->hash = hm2;
|
|
LOG_ALLOC("copy_mapping - hash", SIZEOF_MH(hm2), sizeof *hm - sizeof *mcp + sizeof *mcp * size);
|
|
m->user->mapping_total += SIZEOF_MH(hm2);
|
|
check_total_mapping_size();
|
|
if (m->cond)
|
|
num_dirty_mappings++;
|
|
else
|
|
num_hash_mappings++;
|
|
}
|
|
|
|
|
|
/* --- Copy the condensed part ---
|
|
*/
|
|
|
|
if (NULL != (cm = m->cond) && NULL != (cm2 = m2->cond))
|
|
{
|
|
size_t src_ix;
|
|
svalue_t * src_key, * src_data;
|
|
svalue_t * dest_key, * dest_data;
|
|
|
|
for ( src_ix = 0
|
|
, src_key = &(cm->data[0])
|
|
, dest_key = &(cm2->data[0])
|
|
, dest_data = COND_DATA(cm2, 0, new_width)
|
|
; src_ix < cm->size
|
|
; src_ix++, src_key++)
|
|
{
|
|
if (src_key->type == T_INVALID)
|
|
; /* Do nothing */
|
|
else if (destructed_object_ref(src_key))
|
|
{
|
|
/* We have to fill the space.
|
|
* (Alternatively we could decrease m->cond->size.)
|
|
*/
|
|
p_int i;
|
|
|
|
num_entries--;
|
|
|
|
dest_key->type = T_INVALID;
|
|
dest_key++;
|
|
|
|
for (i = new_width; i > 0; i--, dest_data++)
|
|
put_number(dest_data, 0);
|
|
}
|
|
else
|
|
{
|
|
p_int i;
|
|
|
|
src_data = COND_DATA(cm, src_ix, m->num_values);
|
|
|
|
/* Copy the key and the common data */
|
|
assign_svalue_no_free(dest_key++, src_key);
|
|
for (i = common_width; i > 0; i--)
|
|
assign_svalue_no_free(dest_data++, src_data++);
|
|
|
|
/* Zero out any extraneous values */
|
|
for (i = new_width - common_width; i > 0; i--, dest_data++)
|
|
put_number(dest_data, 0);
|
|
}
|
|
} /* for (all keys) */
|
|
}
|
|
|
|
/* --- Finalize the basis structure ---
|
|
*/
|
|
|
|
m2->num_entries = num_entries;
|
|
|
|
/* That's it. */
|
|
return m2;
|
|
} /* resize_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
mapping_t *
|
|
add_mapping (mapping_t *m1, mapping_t *m2)
|
|
|
|
/* Merge mappings <m1> and <m2> into a new mapping and return it.
|
|
* Entries from <m2> effectively overwrite entries <m1> if their key
|
|
* matches.
|
|
*
|
|
* If <m1> and <m2> differ in the number of values per entry, return
|
|
* a copy of <m1> if non-empty, else return a copy of <m2>.
|
|
*
|
|
* Return NULL if out of memory.
|
|
*
|
|
* To keep the function fast, the condensed part of m3 is always
|
|
* the sum of the condensed parts of m1 and m2: this allows to operate
|
|
* with static limits. To achieve this, entries from m1
|
|
* overwritten by m2 are counted as cond_deleted entries in m3.
|
|
* We leave it to the later compaction phase to get rid of all these
|
|
* entries - if the mapping is still alive then.
|
|
*
|
|
* Note: The mappings (or at least mapping m2) should not contain destructed
|
|
* objects, ie. check_map_for_destr() should be called on both mappings
|
|
* before the addition. If this is not done, strange things may happen to your
|
|
* mappings, though the exact reasons are unclear (b-001204).
|
|
*/
|
|
|
|
{
|
|
mp_int num_values = m1->num_values;
|
|
mapping_t * m3; /* The result mapping */
|
|
mapping_hash_t * hm;
|
|
p_int cm3size;
|
|
|
|
/* Special case: number of values per entry differs.
|
|
* If one of the mappings is empty, the other one is returned.
|
|
* If both mappings contain data, an error is thrown.
|
|
*/
|
|
|
|
if (m2->num_values != num_values)
|
|
{
|
|
if (!m1->num_entries)
|
|
{
|
|
return copy_mapping(m2);
|
|
}
|
|
|
|
if (!m2->num_entries)
|
|
{
|
|
return copy_mapping(m1);
|
|
}
|
|
|
|
errorf("Mappings to be added are of different width: %"PRIdMPINT
|
|
" vs. %"PRIdPINT"\n",
|
|
num_values, m2->num_values);
|
|
}
|
|
|
|
|
|
/* Allocate the result mapping *m3 and initialise it.
|
|
*/
|
|
|
|
{
|
|
p_int hsize = 1; /* Force the creation of the hash */
|
|
|
|
if (m1->hash) hsize += m1->hash->used;
|
|
if (m2->hash) hsize += m2->hash->used;
|
|
|
|
cm3size = 0;
|
|
if (m1->cond) cm3size += m1->cond->size;
|
|
if (m2->cond) cm3size += m2->cond->size;
|
|
|
|
m3 = get_new_mapping(current_object->user, num_values, hsize, cm3size);
|
|
|
|
if (!m3)
|
|
{
|
|
outofmem(sizeof *m3 + sizeof(svalue_t) * hsize * cm3size * num_values
|
|
, "result mapping base structure");
|
|
/* NOTREACHED */
|
|
return NULL;
|
|
}
|
|
}
|
|
|
|
/* Merge the condensed entries.
|
|
* Since the keys are sorted, a simple walk through both mappings
|
|
* in parallel with proper selection does the trick.
|
|
*/
|
|
|
|
if (NULL != m3->cond)
|
|
{
|
|
mapping_cond_t *cm1, *cm2, *cm3;
|
|
svalue_t *src1_key, *src2_key, *dest_key, *dest_data;
|
|
size_t cm1size, cm2size;
|
|
size_t cm1_ix, cm2_ix, num_entries;
|
|
|
|
cm1 = m1->cond;
|
|
cm1size = cm1 ? cm1->size : 0;
|
|
|
|
cm2 = m2->cond;
|
|
cm2size = cm2 ? cm2->size : 0;
|
|
|
|
cm3 = m3->cond;
|
|
|
|
/* Loop over the mappings in parallel */
|
|
for ( cm1_ix = cm2_ix = 0
|
|
, src1_key = cm1 ? &(cm1->data[0]) : NULL
|
|
, src2_key = cm2 ? &(cm2->data[0]) : NULL
|
|
, dest_key = &(cm3->data[0])
|
|
, dest_data = COND_DATA(cm3, 0, num_values)
|
|
, num_entries = 0
|
|
; cm1_ix < cm1size && cm2_ix < cm2size
|
|
; NOOP )
|
|
{
|
|
int cmp;
|
|
p_int i;
|
|
|
|
if (src1_key->type == T_INVALID
|
|
|| destructed_object_ref(src1_key)
|
|
)
|
|
{
|
|
cm1_ix++;
|
|
src1_key++;
|
|
continue;
|
|
}
|
|
|
|
if (src2_key->type == T_INVALID
|
|
|| destructed_object_ref(src2_key)
|
|
)
|
|
{
|
|
cm2_ix++;
|
|
src2_key++;
|
|
continue;
|
|
}
|
|
|
|
/* Ok, it's a new entry */
|
|
m3->num_entries++;
|
|
|
|
cmp = svalue_cmp(src1_key, src2_key);
|
|
|
|
if (cmp < 0)
|
|
{
|
|
svalue_t *src_data = COND_DATA(cm1, cm1_ix, num_values);
|
|
|
|
/* Copy the key and the values */
|
|
assign_svalue_no_free(dest_key++, src1_key);
|
|
for (i = num_values; i > 0; i--)
|
|
assign_svalue_no_free(dest_data++, src_data++);
|
|
|
|
num_entries++;
|
|
cm1_ix++;
|
|
src1_key++;
|
|
}
|
|
else if (cmp >= 0)
|
|
{
|
|
svalue_t *src_data = COND_DATA(cm2, cm2_ix, num_values);
|
|
|
|
/* Copy the key and the values */
|
|
assign_svalue_no_free(dest_key++, src2_key);
|
|
for (i = num_values; i > 0; i--)
|
|
assign_svalue_no_free(dest_data++, src_data++);
|
|
|
|
num_entries++;
|
|
cm2_ix++;
|
|
src2_key++;
|
|
|
|
if (cmp == 0)
|
|
{
|
|
cm1_ix++;
|
|
src1_key++;
|
|
}
|
|
}
|
|
} /* for(mappings in parallel) */
|
|
|
|
/* Copy remaining values from m1 */
|
|
for ( ; cm1_ix < cm1size; cm1_ix++, src1_key++)
|
|
{
|
|
svalue_t *data = COND_DATA(cm1, cm1_ix, num_values);
|
|
p_int i;
|
|
|
|
if (src1_key->type != T_INVALID
|
|
&& !destructed_object_ref(src1_key))
|
|
{
|
|
/* Copy the key and the values */
|
|
assign_svalue_no_free(dest_key++, src1_key);
|
|
for (i = num_values; i > 0; i--)
|
|
assign_svalue_no_free(dest_data++, data++);
|
|
|
|
num_entries++;
|
|
}
|
|
} /* for (remaining values in m1) */
|
|
|
|
/* Copy remaining values from m2 */
|
|
for ( ; cm2_ix < cm2size; cm2_ix++, src2_key++)
|
|
{
|
|
svalue_t *data = COND_DATA(cm2, cm2_ix, num_values);
|
|
p_int i;
|
|
|
|
if (src2_key->type != T_INVALID
|
|
&& !destructed_object_ref(src2_key))
|
|
{
|
|
/* Copy the key and the values */
|
|
assign_svalue_no_free(dest_key++, src2_key);
|
|
for (i = num_values; i > 0; i--)
|
|
assign_svalue_no_free(dest_data++, data++);
|
|
|
|
num_entries++;
|
|
}
|
|
} /* for (remaining values in m2) */
|
|
|
|
/* We have now num_entries entries in m3.
|
|
* Any remaining space in cm3 counts as 'deleted', so
|
|
* initialise it accordingly.
|
|
*/
|
|
m3->num_entries = num_entries;
|
|
m3->hash->cond_deleted = cm3size - num_entries;
|
|
|
|
for ( ; (p_int)num_entries < cm3size; num_entries++)
|
|
{
|
|
p_int i;
|
|
|
|
dest_key->type = T_INVALID; dest_key++;
|
|
|
|
for (i = num_values; i > 0; i--, dest_data++)
|
|
{
|
|
put_number(dest_data, 0);
|
|
}
|
|
|
|
}
|
|
} /* Merge condensed entries */
|
|
|
|
/* Now copy the two hash parts, using get_map_lvalue() to create
|
|
* the new hashed entries
|
|
*
|
|
* First m1...
|
|
*/
|
|
if ( NULL != (hm = m1->hash) )
|
|
{
|
|
map_chain_t **mcp;
|
|
p_int size;
|
|
|
|
size = hm->mask + 1;
|
|
mcp = hm->chains;
|
|
do {
|
|
map_chain_t *mc;
|
|
|
|
for (mc = *mcp++; mc; mc = mc->next)
|
|
{
|
|
svalue_t * src, * dest;
|
|
p_int i;
|
|
|
|
src = &(mc->data[0]);
|
|
dest = get_map_lvalue_unchecked(m3, src);
|
|
if (!dest)
|
|
{
|
|
free_mapping(m3);
|
|
return NULL;
|
|
}
|
|
for (src++, i = num_values; --i >= 0; )
|
|
assign_svalue(dest++, src++);
|
|
}
|
|
} while (--size);
|
|
}
|
|
|
|
/* ...now m2, potentially overwriting the entries from m1.
|
|
*/
|
|
if ( NULL != (hm = m2->hash) )
|
|
{
|
|
map_chain_t **mcp;
|
|
p_int size;
|
|
|
|
size = hm->mask + 1;
|
|
mcp = hm->chains;
|
|
do {
|
|
map_chain_t *mc;
|
|
|
|
for (mc = *mcp++; mc; mc = mc->next)
|
|
{
|
|
svalue_t * src, * dest;
|
|
p_int i;
|
|
|
|
src = &(mc->data[0]);
|
|
dest = get_map_lvalue_unchecked(m3, src);
|
|
if (!dest)
|
|
{
|
|
free_mapping(m3);
|
|
return NULL;
|
|
}
|
|
for (src++, i = num_values; --i >= 0; )
|
|
assign_svalue(dest++, src++);
|
|
}
|
|
} while (--size);
|
|
}
|
|
|
|
/* And that's it :-) */
|
|
return m3;
|
|
|
|
} /* add_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
void
|
|
walk_mapping ( mapping_t *m
|
|
, void (*func) (svalue_t *key, svalue_t *val, void *extra)
|
|
, void *extra)
|
|
|
|
/* Generic function to perform a mapping walk. The function visits every
|
|
* valid entry of <m> and for each entry calls <func>, passing the
|
|
* current key, the current value(s) and the parameter <extra> to the
|
|
* function.
|
|
*
|
|
* <func> may modify the value(s), but not the key.
|
|
*/
|
|
|
|
{
|
|
mapping_cond_t *cm;
|
|
mapping_hash_t *hm;
|
|
svalue_t *key, *data;
|
|
mp_int num_values;
|
|
|
|
num_values = m->num_values;
|
|
|
|
/* Walk through the condensed data */
|
|
|
|
if (NULL != (cm = m->cond))
|
|
{
|
|
size_t ix;
|
|
|
|
for ( ix = 0, key = &(cm->data[0]), data = COND_DATA(cm, 0, num_values)
|
|
; ix < cm->size
|
|
; ix++, key++, data += num_values
|
|
)
|
|
{
|
|
if (key->type != T_INVALID
|
|
&& !destructed_object_ref(key)
|
|
)
|
|
(*func)(key, data, extra);
|
|
}
|
|
}
|
|
|
|
/* Walk through the hashed data */
|
|
|
|
if (NULL != (hm = m->hash))
|
|
{
|
|
mp_int size;
|
|
|
|
for (size = hm->mask; size >= 0; size--)
|
|
{
|
|
map_chain_t *mc;
|
|
|
|
for (mc = hm->chains[size]; mc != NULL; )
|
|
{
|
|
map_chain_t *next = mc->next;
|
|
if (!destructed_object_ref(&(mc->data[0])))
|
|
(*func)(&(mc->data[0]), &(mc->data[1]), extra);
|
|
mc = next;
|
|
}
|
|
}
|
|
}
|
|
|
|
} /* walk_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
Bool
|
|
compact_mapping (mapping_t *m, Bool force)
|
|
|
|
/* Compact the mapping <m>.
|
|
*
|
|
* If <force> is TRUE, always compact the mapping.
|
|
* If <force> is FALSE, the mappings is compacted if
|
|
* - have a .last_used time of 2*TIME_TO_COMPACT or more seconds earlier,
|
|
* - or have to have at least half of their condensed entries deleted
|
|
* and have a .last_used time of TIME_TO_COMPACT or more seconds earlier.
|
|
*
|
|
* Return TRUE if the mapping has been freed altogether in the function
|
|
* (ie. <m> is now invalid), or FALSE if it still exists.
|
|
*
|
|
* The merger is a two step process: first, all hashed entries are
|
|
* sorted, then the sorted entries are merged with the condensed part.
|
|
* The sort itself is done using Mergesort, with special treatment for those
|
|
* portions that don't make up the current power of 2.
|
|
*
|
|
* The function is big, but functionally simple: there is only so
|
|
* much complexity in a Mergesort.
|
|
*/
|
|
|
|
{
|
|
int old_malloc_privilege = malloc_privilege;
|
|
/* Since it will be set temporarily to MALLOC_SYSTEM */
|
|
|
|
Bool checked_map_for_destr = MY_FALSE;
|
|
/* Flag if check_map_for_destr() has been called. */
|
|
|
|
mapping_hash_t *hm;
|
|
/* The hash part of m (guaranteed to exist!) */
|
|
mapping_cond_t *cm;
|
|
/* The condensed part of m */
|
|
int num_values;
|
|
/* Number of values per entry */
|
|
|
|
mapping_t *m2;
|
|
/* Temporary holder for the compacted result mapping */
|
|
mapping_cond_t *cm2;
|
|
/* The new condensed part of the mapping */
|
|
|
|
map_chain_t *hook1, *hook2;
|
|
/* All hashed entries in two long chains.
|
|
*/
|
|
|
|
mp_int count1, count2;
|
|
map_chain_t **mcpp, *mcp, *next;
|
|
map_chain_t *last_hash;
|
|
/* Auxiliaries */
|
|
|
|
mp_int runlength;
|
|
/* Current Mergesort partition length */
|
|
|
|
malloc_privilege = MALLOC_SYSTEM;
|
|
/* compact_mappings() may be called in very low memory situations,
|
|
* so it has to be allowed to use the system reserve.
|
|
* Neat sideeffect: all allocations are guaranteed to work (or
|
|
* the driver terminates).
|
|
*/
|
|
|
|
if (last_indexing_protector.type == T_PROTECTOR_MAPPING)
|
|
{
|
|
/* There is a slight chance that free_protector_mapping causes
|
|
* remove_empty_mappings().
|
|
*/
|
|
free_protector_mapping(last_indexing_protector.u.map);
|
|
last_indexing_protector.type = T_NUMBER;
|
|
}
|
|
|
|
#ifdef DEBUG
|
|
if (!m->user)
|
|
fatal("No wizlist pointer for mapping\n");
|
|
#endif
|
|
|
|
m->ref++; /* prevent freeing while using in case of recursive
|
|
* mappings referenced by a deleted value
|
|
*/
|
|
|
|
hm = m->hash;
|
|
cm = m->cond;
|
|
|
|
if (hm && hm->ref) {
|
|
fatal("compact_mapping(): remaining protector ref count %"
|
|
PRIdPINT"!\n", hm->ref);
|
|
}
|
|
|
|
/* Test if the mapping is dirty at all.
|
|
*/
|
|
if (!hm)
|
|
{
|
|
check_map_for_destr(m); /* may create a hash part */
|
|
checked_map_for_destr = MY_TRUE;
|
|
hm = m->hash;
|
|
cm = m->cond;
|
|
}
|
|
|
|
if (!hm)
|
|
{
|
|
LOG_SUB("compact_mapping(): no hash part", 0);
|
|
malloc_privilege = old_malloc_privilege;
|
|
check_total_mapping_size();
|
|
|
|
return free_mapping(m);
|
|
}
|
|
|
|
/* Test the compaction criterium.
|
|
* By testing it before check_map_for_destr(), the size related
|
|
* criterias might trigger later than desired, but the time criterium
|
|
* makes sure that we won't miss one.
|
|
*/
|
|
if (!force
|
|
&& !( current_time - hm->last_used >= TIME_TO_COMPACT
|
|
&& ( hm->cond_deleted * 2 >= m->num_entries - hm->used
|
|
|| hm->used >= m->num_entries - hm->used - hm->cond_deleted
|
|
|| current_time - hm->last_used >= 2*TIME_TO_COMPACT
|
|
)
|
|
)
|
|
)
|
|
{
|
|
/* This mapping doesn't qualify for compaction.
|
|
*/
|
|
m->ref--; /* undo the ref increment from above */
|
|
malloc_privilege = old_malloc_privilege;
|
|
return MY_FALSE;
|
|
}
|
|
|
|
/* Detect all destructed entries - the compaction algorithm
|
|
* relies on it.
|
|
*/
|
|
if (!checked_map_for_destr)
|
|
{
|
|
check_map_for_destr(m);
|
|
checked_map_for_destr = MY_TRUE;
|
|
hm = m->hash;
|
|
cm = m->cond;
|
|
}
|
|
|
|
/* Test if the mapping needs compaction at all.
|
|
* If not, just delete the hash part (if any).
|
|
*/
|
|
if (!hm->used && !hm->cond_deleted)
|
|
{
|
|
LOG_SUB("compact_mapping(): no need to", SIZEOF_MH(hm));
|
|
malloc_privilege = old_malloc_privilege;
|
|
m->user->mapping_total -= SIZEOF_MH(hm);
|
|
m->hash = NULL;
|
|
|
|
if (m->cond)
|
|
num_dirty_mappings--;
|
|
else
|
|
num_hash_mappings--;
|
|
check_total_mapping_size();
|
|
|
|
xfree(hm);
|
|
|
|
/* the ref count has been incremented above; on the other
|
|
* hand, the last real reference might have gone with the
|
|
* deleted keys. If that is the case, free_mapping() will
|
|
* deallocate it (since we NULLed out the .hash).
|
|
*/
|
|
return free_mapping(m);
|
|
}
|
|
|
|
/* This mapping can be compacted, and there is something to compact. */
|
|
|
|
/* Get the temporary result mapping (we need the condensed block
|
|
* anyway, and this way it's simple to keep the statistics
|
|
* straight).
|
|
*/
|
|
|
|
if (m->cond && m->hash)
|
|
num_dirty_mappings--;
|
|
else if (m->hash)
|
|
num_hash_mappings--;
|
|
|
|
num_values = m->num_values;
|
|
|
|
m2 = get_new_mapping(m->user, num_values, 0, m->num_entries);
|
|
cm2 = m2->cond;
|
|
|
|
if (cm2 != NULL)
|
|
{
|
|
/* --- Setup Mergesort ---
|
|
*
|
|
* Unravel all hash chains into two chains, dangling from hook1
|
|
* and hook2.
|
|
*
|
|
* The chains differ in length by at most 1 element. Within
|
|
* the chains, the elements are pairwise sorted.
|
|
*
|
|
* In this loop, hook1 is always the next chain to add to,
|
|
* and last_hash is the first element of the next pair to add.
|
|
*/
|
|
mcpp = hm->chains;
|
|
count1 = hm->mask;
|
|
hook1 = hook2 = NULL;
|
|
last_hash = NULL;
|
|
|
|
do {
|
|
mcp = *mcpp;
|
|
*mcpp++ = NULL; /* m no longer owns this chain */
|
|
while (mcp)
|
|
{
|
|
next = mcp->next;
|
|
|
|
if (last_hash)
|
|
{
|
|
int d = svalue_cmp(&(mcp->data[0]), &(last_hash->data[0]));
|
|
|
|
if (d < 0) {
|
|
last_hash->next = hook1;
|
|
mcp->next = last_hash;
|
|
hook1 = hook2;
|
|
hook2 = mcp;
|
|
} else {
|
|
mcp->next = hook1;
|
|
last_hash->next = mcp;
|
|
hook1 = hook2;
|
|
hook2 = last_hash;
|
|
}
|
|
last_hash = NULL;
|
|
}
|
|
else
|
|
{
|
|
last_hash = mcp;
|
|
}
|
|
mcp = next;
|
|
}
|
|
} while (--count1 >= 0);
|
|
|
|
/* Add the remaining odd element */
|
|
if (last_hash)
|
|
{
|
|
last_hash->next = hook1;
|
|
hook1 = last_hash;
|
|
}
|
|
|
|
|
|
/* --- Mergesort the hashed entries ---
|
|
*
|
|
* Sort hook1 and hook2 into hook1.
|
|
*/
|
|
for (runlength = 2; runlength < hm->used; runlength <<= 1)
|
|
{
|
|
map_chain_t *out_hook1, *out_hook2, **out1, **out2;
|
|
/* The output chains, which serve as input chains in
|
|
* the next pass
|
|
*/
|
|
|
|
count1 = hm->used & (runlength-1);
|
|
count2 = hm->used & runlength;
|
|
if (!count1)
|
|
{
|
|
out2 = &out_hook1;
|
|
*out2 = hook2;
|
|
while (--count2 >= 0) {
|
|
out2 = &(*out2)->next;
|
|
}
|
|
hook2 = *out2;
|
|
count1 = count2 = runlength;
|
|
out1 = &out_hook2;
|
|
}
|
|
else if (!count2)
|
|
{
|
|
out2 = &out_hook1;
|
|
*out2 = hook1;
|
|
do {
|
|
out2 = &(*out2)->next;
|
|
} while (--count1);
|
|
hook1 = *out2;
|
|
count1 = count2 = runlength;
|
|
out1 = &out_hook2;
|
|
}
|
|
else
|
|
{
|
|
out1 = &out_hook1;
|
|
out2 = &out_hook2;
|
|
}
|
|
|
|
while (hook1)
|
|
{
|
|
/* Sort the next runlength elements onto out1 */
|
|
while (1) {
|
|
int d = svalue_cmp(&(hook1->data[0]), &(hook2->data[0]));
|
|
|
|
if (d > 0)
|
|
{
|
|
*out1 = hook2;
|
|
out1 = &hook2->next;
|
|
hook2 = *out1;
|
|
if (!--count2)
|
|
{
|
|
*out1 = hook1;
|
|
do {
|
|
out1 = &(*out1)->next;
|
|
} while (--count1);
|
|
hook1 = *out1;
|
|
break;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
*out1 = hook1;
|
|
out1 = &hook1->next;
|
|
hook1 = *out1;
|
|
if (!--count1)
|
|
{
|
|
*out1 = hook2;
|
|
do {
|
|
out1 = &(*out1)->next;
|
|
} while (--count2);
|
|
hook2 = *out1;
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
|
|
/* Now switch the chains */
|
|
{
|
|
map_chain_t **temp;
|
|
|
|
temp = out1;
|
|
out1 = out2;
|
|
out2 = temp;
|
|
}
|
|
count1 = count2 = runlength;
|
|
}
|
|
|
|
/* Terminate the out-chains and set them up
|
|
* as next input chains.
|
|
*/
|
|
*out1 = NULL;
|
|
*out2 = NULL;
|
|
hook1 = out_hook1;
|
|
hook2 = out_hook2;
|
|
}
|
|
if (!hook1)
|
|
hook1 = hook2;
|
|
|
|
|
|
/* --- Merge the old condensed part with the sorted lists ---
|
|
*/
|
|
{
|
|
size_t src_ix; /* Index into the old keys */
|
|
svalue_t *src_key, *src_data;
|
|
svalue_t *dest_key, *dest_data;
|
|
|
|
src_ix = 0;
|
|
src_key = cm ? &(cm->data[0]) : NULL;
|
|
src_data = cm ? COND_DATA(cm, 0, num_values) : NULL;
|
|
dest_key = &(cm2->data[0]);
|
|
dest_data = COND_DATA(cm2, 0, num_values);
|
|
|
|
/* Do the actual merge.
|
|
*/
|
|
while (hook1 && cm != NULL && src_ix < cm->size)
|
|
{
|
|
int d;
|
|
|
|
if (src_key->type == T_INVALID)
|
|
{
|
|
src_ix++;
|
|
src_key++;
|
|
src_data += num_values;
|
|
continue;
|
|
}
|
|
|
|
d = svalue_cmp(src_key, &(hook1->data[0]));
|
|
|
|
if (d > 0)
|
|
{
|
|
/* Take entry from hook1 */
|
|
|
|
map_chain_t *temp;
|
|
svalue_t *src;
|
|
p_int i;
|
|
|
|
*dest_key++ = hook1->data[0];
|
|
|
|
for (src = &(hook1->data[1]), i = num_values; i > 0; --i)
|
|
*dest_data++ = *src++;
|
|
|
|
temp = hook1;
|
|
hook1 = temp->next;
|
|
free_map_chain(m, temp, MY_TRUE);
|
|
}
|
|
else
|
|
{
|
|
/* Take entry from the old condensed part */
|
|
|
|
p_int i;
|
|
|
|
*dest_key++ = *src_key++;
|
|
|
|
for (i = num_values; i > 0; --i)
|
|
*dest_data++ = *src_data++;
|
|
|
|
src_ix++;
|
|
}
|
|
} /* if (hook1 && src_ix < cm->size) */
|
|
|
|
/* Copy any remaining entries from the old condensed part
|
|
* or the misc_hook1
|
|
*/
|
|
if (cm != NULL && src_ix < cm->size)
|
|
{
|
|
/* Copy from the old condensed part */
|
|
|
|
while (src_ix < cm->size)
|
|
{
|
|
if (src_key->type != T_INVALID)
|
|
{
|
|
p_int i;
|
|
|
|
*dest_key++ = *src_key++;
|
|
|
|
for (i = num_values; i > 0; --i)
|
|
*dest_data++ = *src_data++;
|
|
}
|
|
else
|
|
{
|
|
src_key++;
|
|
src_data += num_values;
|
|
}
|
|
src_ix++;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* Copy from hook1 */
|
|
|
|
while (hook1)
|
|
{
|
|
map_chain_t *temp;
|
|
svalue_t *src;
|
|
p_int i;
|
|
|
|
*dest_key++ = hook1->data[0];
|
|
|
|
for (src = &(hook1->data[1]), i = num_values; i > 0; --i)
|
|
*dest_data++ = *src++;
|
|
|
|
temp = hook1;
|
|
hook1 = temp->next;
|
|
free_map_chain(m, temp, MY_TRUE);
|
|
}
|
|
}
|
|
} /* --- End of Merge --- */
|
|
} /* --- if (cm2 != NULL) --- */
|
|
|
|
/* Switch the new key and data blocks from m2 to m, and
|
|
* vice versa for the old ones. We don't assign the hash block
|
|
* as we already deleted all the map_chain structures.
|
|
*/
|
|
m->cond = cm2;
|
|
m2->cond = cm;
|
|
|
|
m->hash = NULL; /* Since we compacted it away */
|
|
|
|
LOG_SUB("compact_mapping() - remove old hash", SIZEOF_MH(hm));
|
|
malloc_privilege = old_malloc_privilege;
|
|
m->user->mapping_total -= SIZEOF_MH(hm);
|
|
check_total_mapping_size();
|
|
/* The memorysize for the map_chain_t structure has already been
|
|
* subtracted.
|
|
*/
|
|
|
|
xfree(hm);
|
|
|
|
free_empty_mapping(m2);
|
|
/* Get rid of the temporary mapping and the old cond block.
|
|
*/
|
|
|
|
return free_mapping(m);
|
|
/* Undo the initial m->ref++; if there was a recursive
|
|
* reference which is now gone, the mapping will be deallocated
|
|
* now.
|
|
*/
|
|
|
|
} /* compact_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
#ifdef CHECK_MAPPING_TOTAL
|
|
void
|
|
m_check_total_mapping_size (const char * file, int line)
|
|
|
|
/* Check the sanity of the total amount of memory recorded for all
|
|
* mappings in the system. If the value becomes bogus, log a message.
|
|
*/
|
|
|
|
{
|
|
static mp_int last_size = 0;
|
|
static Bool last_size_ok = MY_TRUE;
|
|
wiz_list_t *wl;
|
|
mp_int total;
|
|
#ifdef MALLOC_smalloc
|
|
mp_int available;
|
|
#endif
|
|
Bool this_size_ok = MY_TRUE;
|
|
|
|
#ifdef MALLOC_smalloc
|
|
available = available_memory();
|
|
#endif
|
|
total = default_wizlist_entry.mapping_total;
|
|
for (wl = all_wiz; wl; wl = wl->next)
|
|
{
|
|
total += wl->mapping_total;
|
|
}
|
|
|
|
if (total < 0
|
|
#ifdef MALLOC_smalloc
|
|
|| total > available
|
|
#endif
|
|
)
|
|
this_size_ok = MY_FALSE;
|
|
|
|
if (last_size_ok && !this_size_ok)
|
|
{
|
|
dprintf3(gcollect_outfd, "DEBUG: (%s : %d) Invalid total mapping size %d"
|
|
, (p_int)file, (p_int)line, (p_int)total);
|
|
#ifdef MALLOC_smalloc
|
|
dprintf1(gcollect_outfd, " (avail %d)", (p_int)available);
|
|
#endif
|
|
dprintf1(gcollect_outfd, ", was %d\n", (p_int)last_size);
|
|
}
|
|
|
|
last_size_ok = this_size_ok;
|
|
last_size = total;
|
|
}
|
|
#endif /* CHECK_MAPPING_TOTAL */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
mp_int
|
|
total_mapping_size (void)
|
|
|
|
/* Return the amount of memory used by all mappings in the system
|
|
*/
|
|
|
|
{
|
|
wiz_list_t *wl;
|
|
mp_int total;
|
|
|
|
total = default_wizlist_entry.mapping_total;
|
|
for (wl = all_wiz; wl; wl = wl->next) {
|
|
total += wl->mapping_total;
|
|
}
|
|
return total;
|
|
} /* total_mapping_size() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
size_t
|
|
mapping_overhead (mapping_t *m)
|
|
|
|
/* Return the memory overhead size of the given mapping <m>.
|
|
*/
|
|
|
|
{
|
|
size_t rc = 0;
|
|
|
|
rc = sizeof(*m);
|
|
if (m->cond)
|
|
rc += sizeof(m->cond) - sizeof(svalue_t);
|
|
if (m->hash)
|
|
rc += SIZEOF_MH(m->hash)
|
|
+ m->hash->used * (sizeof(map_chain_t) - sizeof(svalue_t))
|
|
;
|
|
|
|
return rc;
|
|
} /* mapping_overhead() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
|
|
/* Structure used by set_mapping_user() to communicate with ..._filter()
|
|
*/
|
|
struct set_mapping_user_locals
|
|
{
|
|
p_int num_values; /* Number of values per key */
|
|
object_t *owner; /* Owner to set */
|
|
svalue_t **hairy;
|
|
/* Next free entry in the array of keys which need manual tweaking */
|
|
};
|
|
|
|
|
|
static void
|
|
set_mapping_user_filter (svalue_t *key, svalue_t *data, void *extra)
|
|
|
|
/* walk_mapping-callback function used by set_mapping_user().
|
|
* <extra> points in fact to a struct set_mapping_user_locals.
|
|
*
|
|
* Set the owner of <key> and all <data> to extra.owner (this might call
|
|
* set_mapping_user() recursively).
|
|
*
|
|
* If the key needs special treatment (ie. changing the owner would change
|
|
* its sort index), it is left unchanged and a memory copy of it is stored in
|
|
* extra.hairy++.
|
|
*/
|
|
|
|
{
|
|
p_int i;
|
|
struct set_mapping_user_locals *locals;
|
|
object_t *owner;
|
|
|
|
locals = (struct set_mapping_user_locals *)extra;
|
|
owner = locals->owner;
|
|
|
|
if (key->type == T_CLOSURE)
|
|
{
|
|
*(locals->hairy++) = key;
|
|
}
|
|
else
|
|
{
|
|
set_svalue_user(key, owner);
|
|
}
|
|
for (i = locals->num_values; --i > 0;)
|
|
{
|
|
set_svalue_user(data++, owner);
|
|
}
|
|
}
|
|
|
|
void
|
|
set_mapping_user (mapping_t *m, object_t *owner)
|
|
|
|
/* Set the <owner> as the user of mapping <m> and all its contained
|
|
* keys and values, and update the wizlist entry for <owner>.
|
|
*
|
|
* As this function is called only for variables in newly compiled
|
|
* objects, there is no need to guard against recursive
|
|
* calls for this particular mapping.
|
|
*/
|
|
|
|
{
|
|
p_int num_values;
|
|
mp_int total;
|
|
wiz_list_t *user;
|
|
struct set_mapping_user_locals locals;
|
|
svalue_t **first_hairy;
|
|
mp_int i;
|
|
|
|
num_values = m->num_values;
|
|
|
|
/* Move the total size in the wizlist from the old owner
|
|
* to the new one
|
|
*/
|
|
total = (mp_int)( sizeof(*m)
|
|
+ ((m->cond) ? SIZEOF_MC(m->cond, m->num_values) : 0)
|
|
);
|
|
LOG_SUB("set_mapping_user", total);
|
|
m->user->mapping_total -= total;
|
|
check_total_mapping_size();
|
|
user = owner->user;
|
|
m->user = user;
|
|
LOG_ADD("set_mapping_user", total);
|
|
m->user->mapping_total += total;
|
|
check_total_mapping_size();
|
|
|
|
|
|
/* Walk the mapping to set all owners */
|
|
|
|
locals.owner = owner;
|
|
locals.num_values = num_values;
|
|
first_hairy = alloca(((m->cond) ? m->cond->size : 1) * sizeof(svalue_t *));
|
|
if (!first_hairy)
|
|
{
|
|
errorf("Stack overflow.\n");
|
|
/* NOTREACHED */
|
|
return;
|
|
}
|
|
locals.hairy = first_hairy;
|
|
walk_mapping(m, set_mapping_user_filter, &locals);
|
|
|
|
/* All 'hairy' keys are changed by reassignment to the mapping.
|
|
* Be aware that changing the user might not change the search order.
|
|
*/
|
|
for (i = locals.hairy - first_hairy; --i >= 0; first_hairy++)
|
|
{
|
|
svalue_t new_key, *dest, *source;
|
|
mp_int j;
|
|
|
|
/* Create the new key by changing its owner */
|
|
assign_svalue_no_free(&new_key, *first_hairy);
|
|
set_svalue_user(&new_key, owner);
|
|
|
|
/* Create a new entry in the mapping for the new key */
|
|
dest = get_map_lvalue_unchecked(m, &new_key);
|
|
if (!dest)
|
|
{
|
|
outofmemory("key with new owner");
|
|
/* NOTREACHED */
|
|
return;
|
|
}
|
|
free_svalue(&new_key);
|
|
|
|
/* Move the values from the old entry to the new one, invalidating
|
|
* the old ones by this.
|
|
*/
|
|
source = get_map_value(m, *first_hairy);
|
|
if (source != dest)
|
|
{
|
|
if (num_values)
|
|
memcpy((char *)dest, (char *)source, num_values * sizeof *dest);
|
|
for (j = num_values; --j > 0; source++)
|
|
source->type = T_INVALID;
|
|
|
|
/* Remove the old entry */
|
|
remove_mapping(m, *first_hairy);
|
|
}
|
|
}
|
|
} /* set_mapping_user() */
|
|
|
|
|
|
#ifdef GC_SUPPORT
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
void
|
|
clear_mapping_size (void)
|
|
|
|
/* Clear the statistics about the number and memory usage of all mappings
|
|
* in the game.
|
|
*/
|
|
|
|
{
|
|
wiz_list_t *wl;
|
|
|
|
num_mappings = 0;
|
|
default_wizlist_entry.mapping_total = 0;
|
|
for (wl = all_wiz; wl; wl = wl->next)
|
|
wl->mapping_total = 0;
|
|
check_total_mapping_size();
|
|
} /* clear_mapping_size(void) */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
void
|
|
count_mapping_size (mapping_t *m)
|
|
|
|
/* Add the mapping <m> to the statistics.
|
|
* This method is called from the garbage collector only, at which point
|
|
* the .hash member is either NULL or used as link pointer for a list
|
|
* of stale mappings.
|
|
*/
|
|
|
|
{
|
|
mp_int total;
|
|
|
|
num_mappings++;
|
|
|
|
total = sizeof(*m);
|
|
#if 0 && defined(CHECK_MAPPING_TOTAL)
|
|
dprintf3(gcollect_outfd, "DEBUG: map '%s' %d (num values %d)"
|
|
, (p_int)(m->user->name ? get_txt(m->user->name) : "<0>")
|
|
, (p_int)total, (p_int)m->num_values);
|
|
#endif
|
|
|
|
if (m->cond != NULL)
|
|
{
|
|
mp_int subtotal;
|
|
|
|
subtotal = SIZEOF_MC(m->cond, m->num_values);
|
|
total += subtotal;
|
|
#if 0 && defined(CHECK_MAPPING_TOTAL)
|
|
dprintf2(gcollect_outfd, " + %d (size %d)"
|
|
, (p_int)subtotal
|
|
, (p_int)m->cond->size
|
|
);
|
|
#endif
|
|
}
|
|
|
|
/* m->hash does not point to a hash structure at this time */
|
|
|
|
#if 0 && defined(CHECK_MAPPING_TOTAL)
|
|
dprintf1(gcollect_outfd, " = %d\n", (p_int)total);
|
|
#endif
|
|
|
|
m->user->mapping_total += total;
|
|
check_total_mapping_size();
|
|
} /* count_mapping_size(void) */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
static void
|
|
handle_destructed_key (svalue_t *key)
|
|
|
|
/* GC support: <key> has been found to be a key referencing a destructed
|
|
* object. This function modifies it so that the GC wont choke.
|
|
*/
|
|
|
|
{
|
|
if (key->type == T_CLOSURE &&
|
|
key->x.closure_type == CLOSURE_BOUND_LAMBDA)
|
|
{
|
|
/* Avoid changing keys: collapse the bound/unbound combination
|
|
* into a single lambda closure bound to the destructed
|
|
* object. This way the GC will treat it correctly.
|
|
*/
|
|
lambda_t *l = key->u.lambda;
|
|
|
|
key->x.closure_type = CLOSURE_LAMBDA;
|
|
key->u.lambda = l->function.lambda;
|
|
if (!l->ref)
|
|
{
|
|
/* This would have been the first reference to the
|
|
* lambda closure: add it to the stale list and mark
|
|
* it as 'stale'.
|
|
*/
|
|
l->function.lambda->ob = l->ob;
|
|
l->ref = -1;
|
|
l->ob = (object_t *)stale_misc_closures;
|
|
stale_misc_closures = l;
|
|
}
|
|
else
|
|
{
|
|
/* Closure is already been marked as 'stale': no need
|
|
* to do anything about it, but but since l->ob is no
|
|
* longer a valid object, we need to use a known
|
|
* destructed object as stand-in for remaining lambda.
|
|
* TODO: Having a type CLOSURE_DESTRUCTED_LAMBDA
|
|
* TODO:: might be safer? After all,
|
|
* TODO:: gc_obj_list_destructed might be NULL.
|
|
*/
|
|
#ifdef DEBUG
|
|
if (gc_obj_list_destructed)
|
|
fatal("gc_obj_list_destructed is NULL\n");
|
|
#endif
|
|
l->function.lambda->ob = gc_obj_list_destructed;
|
|
}
|
|
}
|
|
count_ref_in_vector(key, 1);
|
|
if (key->type == T_CLOSURE)
|
|
{
|
|
/* *key has been transformed by count_ref_in_vector()
|
|
* into an efun closure bound to the master.
|
|
*/
|
|
key->u.ob->ref--;
|
|
}
|
|
|
|
/* Don't bother freeing the svalues - this is the GC after all,
|
|
* and freeing them might even confuse the memory allocator.
|
|
*/
|
|
key->type = T_INVALID;
|
|
} /* handle_destructed_key() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
void
|
|
count_ref_in_mapping (mapping_t *m)
|
|
|
|
/* GC support: Count all references by the mapping <m>.
|
|
*
|
|
* If the mapping contains keys referencing destructed objects/lambdas,
|
|
* it is added to the list of stale mappings.
|
|
*/
|
|
|
|
{
|
|
mp_int size;
|
|
mp_int num_values;
|
|
Bool any_destructed = MY_FALSE;
|
|
|
|
num_values = m->num_values;
|
|
|
|
/* Mark the blocks as referenced */
|
|
if (m->cond)
|
|
note_malloced_block_ref(m->cond);
|
|
if (m->hash)
|
|
note_malloced_block_ref(m->hash);
|
|
|
|
/* Count references by condensed keys and their data.
|
|
* Take special care of keys referencing destructed objects/lambdas.
|
|
*/
|
|
|
|
size = m->cond ? m->cond->size : 0;
|
|
while ( --size >= 0)
|
|
{
|
|
svalue_t * key = &(m->cond->data[size]);
|
|
svalue_t * data = COND_DATA(m->cond, size, num_values);
|
|
|
|
if (destructed_object_ref(key))
|
|
{
|
|
/* This key is a destructed object, resp. is bound to a destructed
|
|
* object. The entry has to be deleted.
|
|
*/
|
|
handle_destructed_key(key);
|
|
m->num_entries--;
|
|
|
|
any_destructed = MY_TRUE;
|
|
}
|
|
else
|
|
{
|
|
count_ref_in_vector(key, 1);
|
|
count_ref_in_vector(data, num_values);
|
|
}
|
|
}
|
|
|
|
/* Count references by hashed keys and their data.
|
|
* Take special care of keys referencing destructed objects/lambdas.
|
|
*/
|
|
size = m->hash ? m->hash->mask+1 : 0;
|
|
while ( --size >= 0)
|
|
{
|
|
map_chain_t * mc = m->hash->chains[size];
|
|
|
|
for ( ; mc != NULL; mc = mc->next)
|
|
{
|
|
note_malloced_block_ref(mc);
|
|
if (destructed_object_ref(mc->data))
|
|
{
|
|
/* This key is a destructed object, resp. is bound to a
|
|
* destructed object. The entry has to be deleted.
|
|
*/
|
|
handle_destructed_key(mc->data);
|
|
|
|
any_destructed = MY_TRUE;
|
|
}
|
|
else
|
|
{
|
|
count_ref_in_vector(mc->data, 1);
|
|
count_ref_in_vector(mc->data+1, num_values);
|
|
}
|
|
}
|
|
}
|
|
|
|
/* If any stale key was found, link the mapping into the
|
|
* stale mapping list.
|
|
*/
|
|
if (any_destructed)
|
|
{
|
|
m->next = stale_mappings;
|
|
stale_mappings = m;
|
|
/* We are going to use free_svalue() later to get rid of the
|
|
* data asscoiated with the keys. This data might reference
|
|
* mappings with destructed keys... Thus, we must prevent
|
|
* free_mapping() to look at the hash field.
|
|
*/
|
|
m->ref++;
|
|
/* Ref for the stale-mapping link. */
|
|
}
|
|
} /* count_ref_in_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
void
|
|
clean_stale_mappings (void)
|
|
|
|
/* GC support: After count_ref_in_mapping(), the gc will free all
|
|
* unreferenced destructed objects and lambdas. This may have removed
|
|
* several keys in the stale_mappings. Since the objective
|
|
* is to recover memory, we try to compact these mappings now.
|
|
* Be aware that the mappings might be empty now.
|
|
*/
|
|
|
|
{
|
|
mapping_t *m, *next;
|
|
|
|
for (m = stale_mappings; m; m = next)
|
|
{
|
|
mapping_cond_t *cm;
|
|
mapping_hash_t *hm;
|
|
size_t size;
|
|
mp_int num_cond_entries;
|
|
mp_int num_values;
|
|
mp_int i;
|
|
|
|
/* Unlink from the stale_mapping list */
|
|
next = m->next;
|
|
m->next = NULL;
|
|
|
|
num_values = m->num_values;
|
|
cm = m->cond;
|
|
hm = m->hash;
|
|
|
|
/* Try to reallocate a new condensed block */
|
|
|
|
num_cond_entries = m->num_entries - (hm ? hm->used : 0);
|
|
if (num_cond_entries)
|
|
{
|
|
mapping_cond_t *cm2;
|
|
size_t ix;
|
|
svalue_t *src_key, *src_data;
|
|
svalue_t *dest_key, *dest_data;
|
|
|
|
size = sizeof(*cm2) + sizeof(svalue_t) * (num_cond_entries * (num_values+1) - 1);
|
|
cm2 = xalloc(size);
|
|
if (!cm2)
|
|
{
|
|
#ifdef VERBOSE
|
|
fprintf(stderr, "%s Unable to compact stale mapping: Out of memory "
|
|
"for new condensed block (%zu bytes).\n"
|
|
, time_stamp(), size);
|
|
#endif
|
|
debug_message("%s Unable to compact stale mapping: Out of memory "
|
|
"for new condensed block (%zu bytes).\n"
|
|
, time_stamp(), size);
|
|
|
|
/* No use in even trying to compact the much bigger data
|
|
* block either.
|
|
*/
|
|
continue;
|
|
}
|
|
|
|
cm2->size = num_cond_entries;
|
|
|
|
/* Copy the data */
|
|
for ( ix = 0
|
|
, src_key = &(cm->data[0])
|
|
, src_data = COND_DATA(cm, 0, num_values)
|
|
, dest_key = &(cm2->data[0])
|
|
, dest_data = COND_DATA(cm2, 0, num_values)
|
|
; ix < cm->size
|
|
; ix++, src_key++)
|
|
{
|
|
if (src_key->type != T_INVALID)
|
|
{
|
|
*dest_key++ = *src_key;
|
|
for (i = num_values; i > 0; i--)
|
|
*dest_data++ = *src_data++;
|
|
}
|
|
else
|
|
src_data += num_values;
|
|
}
|
|
|
|
/* Replace the old keyblock by the new one. */
|
|
LOG_ALLOC("clean_stale - new keyblock", SIZEOF_MC(cm2, num_values), size);
|
|
m->user->mapping_total += SIZEOF_MC(cm2, num_values);
|
|
m->cond = cm2;
|
|
}
|
|
else
|
|
{
|
|
/* No condensed block needed. */
|
|
m->cond = NULL;
|
|
}
|
|
|
|
/* Delete the old condensed block, if any */
|
|
if (cm)
|
|
{
|
|
LOG_SUB("clean_state - old keyblock", SIZEOF_MC(cm, num_values));
|
|
m->user->mapping_total -= SIZEOF_MC(cm, num_values);
|
|
xfree(cm);
|
|
}
|
|
|
|
/* Removed all invalid keys from the hash part, if any */
|
|
if (hm && hm->used)
|
|
{
|
|
size_t ix;
|
|
|
|
for (ix = 0; ix <= (size_t)hm->mask; ix++)
|
|
{
|
|
map_chain_t * mc, * mcp;
|
|
|
|
for (mcp = NULL, mc = hm->chains[ix]; mc != NULL ; )
|
|
{
|
|
if (mc->data[0].type == T_INVALID)
|
|
{
|
|
/* This key has been marked for deletion,
|
|
* now remove it altogether.
|
|
*/
|
|
map_chain_t * this = mc;
|
|
|
|
if (mcp == NULL)
|
|
{
|
|
hm->chains[ix] = this->next;
|
|
}
|
|
else
|
|
{
|
|
mcp->next = this->next;
|
|
}
|
|
mc = this->next;
|
|
|
|
m->num_entries--;
|
|
hm->used--;
|
|
m->user->mapping_total -= SIZEOF_MCH(this, num_values);
|
|
xfree(this);
|
|
}
|
|
else
|
|
{
|
|
/* Valid key - just step forward */
|
|
mcp = mc;
|
|
mc = mc->next;
|
|
}
|
|
} /* for(mc) */
|
|
} /* for(ix) */
|
|
} /* hash part */
|
|
|
|
check_total_mapping_size();
|
|
free_mapping(m); /* Undo the ref held by the stale-mapping list */
|
|
}
|
|
} /* clean_stale_mappings() */
|
|
|
|
#endif /* GC_SUPPORT */
|
|
|
|
/*=========================================================================*/
|
|
|
|
/* EFUNS */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
f_m_allocate (svalue_t *sp)
|
|
|
|
/* EFUN m_allocate()
|
|
*
|
|
* mapping m_allocate(int size, int width)
|
|
*
|
|
* Reserve memory for a mapping.
|
|
*
|
|
* size is the number of entries (i.e. keys) to reserve, width is
|
|
* the number of data items per entry. If the optional width is
|
|
* omitted, 1 is used as default.
|
|
*/
|
|
|
|
{
|
|
p_int size = sp[-1].u.number;
|
|
p_int width = sp[0].u.number;
|
|
|
|
if (size < 0)
|
|
errorf("Illegal mapping size: %"PRIdPINT"\n", size);
|
|
if (width < 0)
|
|
errorf("Illegal mapping width: %"PRIdPINT"\n", width);
|
|
|
|
if (max_mapping_size
|
|
&& size * (1 + width) > (p_int)max_mapping_size)
|
|
errorf("Illegal mapping size: %"PRIdMPINT
|
|
" elements (%"PRIdPINT" x %"PRIdPINT").\n",
|
|
(mp_int)size * (1+width),
|
|
size, width);
|
|
|
|
if (max_mapping_keys
|
|
&& size > (p_int)max_mapping_keys)
|
|
errorf("Illegal mapping size: %"PRIdPINT" entries.\n", size);
|
|
|
|
sp--;
|
|
|
|
if (!(sp->u.map = allocate_mapping(size, width)))
|
|
{
|
|
sp++;
|
|
/* sp points to a number-typed svalue, so freeing won't
|
|
* be a problem.
|
|
*/
|
|
errorf("Out of memory for mapping[%"PRIdPINT",%"PRIdPINT"].\n",
|
|
size, width);
|
|
/* NOTREACHED */
|
|
}
|
|
sp->type = T_MAPPING;
|
|
|
|
return sp;
|
|
} /* f_m_allocate() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
v_m_add (svalue_t *sp, int num_arg)
|
|
|
|
/* EFUN m_allocate()
|
|
*
|
|
* mapping m_add(mapping map, mixed key, [mixed data...])
|
|
*
|
|
* Add (or replace) an entry with index <key> in mapping <map>.
|
|
* The modified mapping is also returned as result.
|
|
*
|
|
* The values for the entry are taken from the <data> arguments.
|
|
* Unassigned entry values default to 0, extraneous <data> arguments
|
|
* are ignore.
|
|
*/
|
|
|
|
{
|
|
mapping_t *m;
|
|
svalue_t *argp;
|
|
svalue_t *entry;
|
|
p_int num_values;
|
|
|
|
argp = sp - num_arg + 1;
|
|
m = argp->u.map;
|
|
|
|
/* Get (or create) the mapping entry */
|
|
entry = get_map_lvalue(m, argp+1);
|
|
|
|
/* Transfer the given values from the stack into the mapping
|
|
* entry.
|
|
*/
|
|
num_values = m->num_values;
|
|
if (num_values > num_arg - 2)
|
|
num_values = num_arg - 2;
|
|
for ( argp += 2
|
|
; num_values > 0 && argp <= sp
|
|
; num_values--, argp++, entry++
|
|
)
|
|
{
|
|
transfer_svalue(entry, argp);
|
|
/* And since we take out values from under sp, play it
|
|
* safe:
|
|
*/
|
|
put_number(argp, 0);
|
|
}
|
|
|
|
/* We leave the reference to the mapping on the stack as result,
|
|
* but pop everything else.
|
|
*/
|
|
sp = pop_n_elems(num_arg-1, sp);
|
|
|
|
return sp;
|
|
} /* v_m_add() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
f_m_delete (svalue_t *sp)
|
|
|
|
/* EFUN m_delete()
|
|
*
|
|
* mapping m_delete(mapping map, mixed key)
|
|
*
|
|
* Remove the entry with index 'key' from mapping 'map'. The
|
|
* changed mapping 'map' is also returned as result.
|
|
* If the mapping does not have an entry with index 'key',
|
|
* nothing is changed.
|
|
*/
|
|
|
|
{
|
|
mapping_t *m;
|
|
|
|
m = (sp-1)->u.map;
|
|
remove_mapping(m, sp);
|
|
free_svalue(sp--);
|
|
/* leave the modified mapping on the stack */
|
|
return sp;
|
|
} /* f_m_delete() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
vector_t *
|
|
m_indices (mapping_t *m)
|
|
|
|
/* Create a vector with all keys from mapping <m> and return it.
|
|
* If the mapping contains destructed objects, m_indices() will remove
|
|
* them.
|
|
*
|
|
* The helper function m_indices_filter() is located in interpret.c
|
|
* to take advantage of inlined assign_svalue_no_free().
|
|
*
|
|
* The function is used for efuns m_indices(), map_mapping(), and for
|
|
* the loop construct foreach().
|
|
*/
|
|
|
|
{
|
|
vector_t *v;
|
|
svalue_t *svp;
|
|
mp_int size;
|
|
|
|
check_map_for_destr(m);
|
|
size = MAP_SIZE(m);
|
|
v = allocate_array(size); /* might cause error */
|
|
svp = v->item;
|
|
walk_mapping(m, m_indices_filter, &svp);
|
|
return v;
|
|
} /* m_indices() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
f_m_indices (svalue_t *sp)
|
|
|
|
/* EFUN m_indices()
|
|
*
|
|
* mixed *m_indices(mapping map)
|
|
*
|
|
* Returns an array containing the indices of mapping 'map'.
|
|
*/
|
|
|
|
{
|
|
mapping_t *m;
|
|
vector_t *v;
|
|
|
|
m = sp->u.map;
|
|
v = m_indices(m);
|
|
|
|
free_mapping(m);
|
|
put_array(sp,v);
|
|
|
|
return sp;
|
|
} /* f_m_indices() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
f_m_values (svalue_t *sp)
|
|
|
|
/* EFUN m_values()
|
|
*
|
|
* mixed *m_values(mapping map)
|
|
* mixed *m_values(mapping map, int index)
|
|
*
|
|
* Returns an array with the values of mapping 'map'.
|
|
* If <index> is given as a number between 0 and the width of
|
|
* the mapping, the values from the given column are returned,
|
|
* else the values of the first column.
|
|
*
|
|
* The called filter function m_values_filter() is in interpret.c
|
|
* to take advantage of inline expansion.
|
|
*/
|
|
|
|
{
|
|
mapping_t *m;
|
|
vector_t *v;
|
|
struct mvf_info vip;
|
|
p_int size;
|
|
p_int num;
|
|
|
|
/* Get and check the arguments */
|
|
num = sp->u.number;
|
|
sp--;
|
|
inter_sp = sp;
|
|
|
|
m = sp->u.map;
|
|
if (num < 0 || num >= m->num_values)
|
|
errorf("Illegal index %"PRIdPINT" to m_values(): should be in 0..%"
|
|
PRIdPINT".\n", num, m->num_values-1);
|
|
|
|
/* Get the size of the mapping */
|
|
check_map_for_destr(m);
|
|
size = MAP_SIZE(m);
|
|
|
|
if (size > 0 && m->num_values < 1)
|
|
errorf("m_values() applied on mapping with no values.\n");
|
|
|
|
v = allocate_array(size);
|
|
|
|
/* Extract the desired column from the mapping */
|
|
vip.svp = v->item;
|
|
vip.num = num;
|
|
walk_mapping(m, m_values_filter, &vip);
|
|
free_mapping(m);
|
|
|
|
/* Push the result */
|
|
put_array(sp,v);
|
|
|
|
return sp;
|
|
} /* f_m_values() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
static void
|
|
add_to_mapping_filter (svalue_t *key, svalue_t *data, void *extra)
|
|
|
|
/* Auxiliary function to add_to_mapping():
|
|
* Add/overwrite (key:data) to mapping <extra>.
|
|
*/
|
|
|
|
{
|
|
svalue_t *data2;
|
|
p_int i;
|
|
|
|
data2 = get_map_lvalue_unchecked((mapping_t *)extra, key);
|
|
if (!data2)
|
|
{
|
|
outofmemory("entry added to mapping");
|
|
/* NOTREACHED */
|
|
return;
|
|
}
|
|
if (data2 != data) /* this should always be true */
|
|
{
|
|
for (i = ((mapping_t *)extra)->num_values; --i >= 0;)
|
|
{
|
|
assign_svalue(data2++, data++);
|
|
}
|
|
}
|
|
} /* add_to_mapping_filter() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
void
|
|
add_to_mapping (mapping_t *m1, mapping_t *m2)
|
|
|
|
/* Add the data from mapping <m2> to mapping <m1>, overwriting existing
|
|
* entries.
|
|
*
|
|
* If the values per entry differ, and one of the mappings is empty,
|
|
* the empty mapping's width is set to that of the non-empy one.
|
|
* Otherwise (different width, no mapping empty) the function returns
|
|
* immediately.
|
|
*
|
|
* Called by interpret.c as part of F_ADD_EQ and F_VOID_ADD_EQ.
|
|
*/
|
|
|
|
{
|
|
/* Adding a mapping to itself doesn't change its content. */
|
|
if (m1 == m2)
|
|
return;
|
|
|
|
if (m2->num_values != m1->num_values)
|
|
{
|
|
/* If one of the two mappings is empty, we can adjust its width
|
|
* after getting rid of all pending data blocks.
|
|
*/
|
|
if (0 == m2->num_entries && NULL == m2->hash)
|
|
{
|
|
if (m2->cond != NULL)
|
|
{
|
|
LOG_SUB_M("add_to_mapping - m2 no cond", m2, SIZEOF_MC(m2->cond, m2->num_values));
|
|
m2->user->mapping_total -= SIZEOF_MC(m2->cond, m2->num_values);
|
|
xfree(m2->cond);
|
|
m2->cond = NULL;
|
|
}
|
|
m2->num_values = m1->num_values;
|
|
}
|
|
else if (0 == m1->num_entries && NULL == m1->hash)
|
|
{
|
|
if (m1->cond != NULL)
|
|
{
|
|
LOG_SUB_M("add_to_mapping - m1 no cond", m1, SIZEOF_MC(m2->cond, m2->num_values));
|
|
m1->user->mapping_total -= SIZEOF_MC(m1->cond, m1->num_values);
|
|
xfree(m1->cond);
|
|
m1->cond = NULL;
|
|
}
|
|
m1->num_values = m2->num_values;
|
|
}
|
|
else
|
|
{
|
|
errorf("Mappings to be added are of different width: %"PRIdPINT
|
|
" vs. %"PRIdPINT"\n",
|
|
m1->num_values, m2->num_values);
|
|
return;
|
|
}
|
|
}
|
|
walk_mapping(m2, add_to_mapping_filter, m1);
|
|
} /* add_to_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
void
|
|
sub_from_mapping_filter ( svalue_t *key, svalue_t *data UNUSED
|
|
, void *extra)
|
|
|
|
/* Auxiliary to subtract_mapping(): Delete <key> from mapping <extra>.
|
|
* Also called by interpret.c as part of F_SUB_EQ (which then makes sure
|
|
* that subtrahend and minuend are not identical).
|
|
*/
|
|
|
|
{
|
|
#ifdef __MWERKS__
|
|
# pragma unused(data)
|
|
#endif
|
|
remove_mapping((mapping_t *)extra, key);
|
|
} /* sub_from_mapping_filter() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
mapping_t *
|
|
subtract_mapping (mapping_t *minuend, mapping_t *subtrahend)
|
|
|
|
/* Create a copy of <minuend> minus all entries which are also in
|
|
* <subtrahend>.
|
|
*
|
|
* Called by interpret.c as part of F_SUBTRACT.
|
|
*/
|
|
|
|
{
|
|
/* TODO: This could be done faster, especially if there the mappings are
|
|
* mainly condensed. On the other hand, the priority of fast mapping
|
|
* subtraction is unknown.
|
|
* Also, by providing a copy of the minuend it is safe to subtract
|
|
* a mapping from itself.
|
|
*/
|
|
minuend = copy_mapping(minuend);
|
|
walk_mapping(subtrahend, sub_from_mapping_filter, minuend);
|
|
return minuend;
|
|
} /* subtract_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
struct map_intersect_s
|
|
{
|
|
mapping_t * m; /* Mapping to be intersected */
|
|
mapping_t * rc; /* Result mapping */
|
|
};
|
|
|
|
|
|
static void
|
|
map_intersect_filter (svalue_t *key, svalue_t *data UNUSED, void *extra)
|
|
|
|
/* Auxiliary function to map_intersect():
|
|
* If <key> is in <extra>->m, add the data to <extra>->rc.
|
|
*/
|
|
|
|
{
|
|
#ifdef __MWERKS__
|
|
# pragma unused(data)
|
|
#endif
|
|
mapping_t * m = ((struct map_intersect_s *)extra)->m;
|
|
mapping_t * rc = ((struct map_intersect_s *)extra)->rc;
|
|
|
|
svalue_t * src;
|
|
|
|
src = get_map_value(m, key);
|
|
if (src != &const0)
|
|
{
|
|
p_int num_values = m->num_values;
|
|
svalue_t * dest;
|
|
p_int j;
|
|
|
|
dest = get_map_lvalue(rc, key);
|
|
if (!dest)
|
|
{
|
|
outofmemory("result mapping entry");
|
|
/* NOTREACHED */
|
|
}
|
|
for (j = 0; j < num_values; j++)
|
|
{
|
|
assign_svalue(dest+j, src+j);
|
|
}
|
|
} /* if found element */
|
|
} /* map_intersect_filter() */
|
|
|
|
|
|
mapping_t *
|
|
map_intersect (mapping_t *m, svalue_t * val)
|
|
|
|
/* Intersect mapping <m> with vector/mapping <val>.
|
|
*
|
|
* The result is a new mapping with all those elements of <m> which index
|
|
* can be found in vector <val>->u.vector resp. as index in mapping
|
|
* <val>->u.map. Both <m> and <val> are freed on return.
|
|
*
|
|
* Called by interpret to implement F_AND.
|
|
*/
|
|
|
|
{
|
|
mapping_t *rc = NULL;
|
|
|
|
if (val->type == T_POINTER)
|
|
{
|
|
vector_t * vec = val->u.vec;
|
|
p_int vecsize = VEC_SIZE(vec);
|
|
p_int num_values = m->num_values;
|
|
p_int i;
|
|
|
|
rc = allocate_mapping(vecsize, num_values);
|
|
if (!rc)
|
|
{
|
|
outofmemory("result mapping");
|
|
/* NOTREACHED */
|
|
}
|
|
|
|
for (i = 0; i < vecsize; i++)
|
|
{
|
|
svalue_t * src;
|
|
|
|
src = get_map_value(m, &vec->item[i]);
|
|
if (src != &const0)
|
|
{
|
|
svalue_t * dest;
|
|
p_int j;
|
|
|
|
dest = get_map_lvalue(rc, &vec->item[i]);
|
|
if (!dest)
|
|
{
|
|
outofmemory("result mapping entry");
|
|
/* NOTREACHED */
|
|
}
|
|
for (j = 0; j < num_values; j++)
|
|
{
|
|
assign_svalue(dest+j, src+j);
|
|
}
|
|
} /* if found element */
|
|
} /* for (i) */
|
|
}
|
|
else if (val->type == T_MAPPING)
|
|
{
|
|
mapping_t * map = val->u.map;
|
|
p_int num_values = m->num_values;
|
|
struct map_intersect_s data;
|
|
|
|
rc = allocate_mapping(MAP_SIZE(map), num_values);
|
|
if (!rc)
|
|
{
|
|
outofmemory("result mapping");
|
|
/* NOTREACHED */
|
|
}
|
|
|
|
data.m = m;
|
|
data.rc = rc;
|
|
walk_mapping(map, map_intersect_filter, &data);
|
|
}
|
|
else
|
|
fatal("(map_intersect) Illegal type to arg2: %d, "
|
|
"expected array/mapping."
|
|
, val->type);
|
|
|
|
free_mapping(m);
|
|
free_svalue(val);
|
|
return rc;
|
|
} /* map_intersect() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
vector_t *
|
|
map_intersect_array (vector_t *vec, mapping_t *map)
|
|
|
|
/* OPERATOR & (array/map intersection)
|
|
*
|
|
* Perform an intersection of the vectors <vec> with the indices of
|
|
* mapping <map>.
|
|
*
|
|
* The result is a new vector with all elements which are present in both
|
|
* input vectors.
|
|
*
|
|
* Both <vec> and <map> are freed.
|
|
*/
|
|
|
|
{
|
|
Bool *flags; /* The result from match_arrays() */
|
|
p_int result_size; /* Size of the result array */
|
|
vector_t *result; /* Result array */
|
|
svalue_t *dest; /* Pointer for storing the result elements */
|
|
p_int i;
|
|
|
|
p_int vec_size = VEC_SIZE(vec);
|
|
|
|
/* Handle empty arrays */
|
|
|
|
if (vec_size == 0)
|
|
{
|
|
free_mapping(map);
|
|
return shrink_array(vec, 0);
|
|
/* Fancy way of creating an empty array copy */
|
|
}
|
|
|
|
/* Non-trivial arrays: match them up */
|
|
|
|
xallocate(flags, vec_size * sizeof(Bool), "flag vector");
|
|
memset(flags, 0, vec_size * sizeof(Bool));
|
|
|
|
/* Walk through the vector and check for each element
|
|
* if it exists in the mapping.
|
|
* If it does, set the corresponding flag and count the
|
|
* result size.
|
|
*/
|
|
result_size = 0;
|
|
for (i = 0; i < vec_size; ++i)
|
|
{
|
|
if (get_map_value(map, vec->item+i) != &const0)
|
|
{
|
|
flags[i] = MY_TRUE;
|
|
result_size++;
|
|
}
|
|
}
|
|
|
|
if (result_size == vec_size)
|
|
{
|
|
/* No elements to remove */
|
|
xfree(flags);
|
|
free_mapping(map);
|
|
return vec;
|
|
}
|
|
|
|
if (max_array_size && result_size > max_array_size)
|
|
{
|
|
xfree(flags);
|
|
free_mapping(map);
|
|
free_array(vec);
|
|
errorf("Illegal array size: %"PRIdPINT".\n", result_size);
|
|
}
|
|
|
|
result = allocate_array(result_size);
|
|
|
|
/* Copy the elements to keep from vec into result.
|
|
* We count down result_size to be able to stop as early
|
|
* as possible.
|
|
*/
|
|
for ( dest = result->item, i = 0
|
|
; i < vec_size && result_size != 0
|
|
; i++
|
|
)
|
|
{
|
|
if (flags[i])
|
|
{
|
|
assign_svalue_no_free(dest, vec->item+i);
|
|
dest++;
|
|
result_size--;
|
|
}
|
|
}
|
|
|
|
/* Cleanup and return */
|
|
xfree(flags);
|
|
free_array(vec);
|
|
free_mapping(map);
|
|
|
|
return result;
|
|
} /* map_intersect_array() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
static void
|
|
f_walk_mapping_filter (svalue_t *key, svalue_t *data, void *extra)
|
|
|
|
/* Auxiliary to efuns {walk,filter}_mapping(): callback for walk_mapping().
|
|
*
|
|
* <extra> is a pointer to a (svalue_t *) to an array of 2 svalues.
|
|
* The first of these gets to hold the <key>, the second is an lvalue
|
|
* pointing to <data>.
|
|
*/
|
|
|
|
{
|
|
svalue_t *svp;
|
|
|
|
svp = *(svalue_t **)extra;
|
|
assign_svalue_no_free(svp, key);
|
|
(++svp)->u.lvalue = data;
|
|
*(svalue_t **)extra = ++svp;
|
|
} /* f_walk_mapping_filter() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
static void
|
|
f_walk_mapping_cleanup (svalue_t *arg)
|
|
|
|
/* Auxiliary to efuns {walk,filter}_walk_mapping(): Cleanup.
|
|
*
|
|
* This function is called during the stackcleanup after a mapping walk.
|
|
* <arg> is the array of svalue allocated by walk_mapping_prologue().
|
|
* See walk_mapping_prologue() for details.
|
|
*/
|
|
|
|
{
|
|
svalue_t *svp;
|
|
mapping_t *m;
|
|
mp_int i;
|
|
|
|
svp = arg + 1;
|
|
|
|
if (svp->u.cb)
|
|
free_callback(svp->u.cb);
|
|
svp++;
|
|
|
|
m = svp[1].u.map;
|
|
|
|
/* If the mapping had a hash part prior to the f_walk_mapping(),
|
|
* it was protected by the prologue and we have to lift that
|
|
* protection.
|
|
*/
|
|
if (svp[1].x.generic)
|
|
{
|
|
mapping_hash_t *hm;
|
|
|
|
hm = m->hash;
|
|
|
|
if (!--hm->ref)
|
|
{
|
|
/* Last ref gone: deallocated the pending deleted entries */
|
|
|
|
map_chain_t *mc, *next;
|
|
|
|
for (mc = hm->deleted; mc; mc = next)
|
|
{
|
|
next = mc->next;
|
|
free_map_chain(m, mc, MY_FALSE);
|
|
}
|
|
|
|
hm->deleted = NULL;
|
|
}
|
|
}
|
|
|
|
/* Free the key svalues in the block */
|
|
i = svp->u.number;
|
|
if (i) do
|
|
{
|
|
svp += 2;
|
|
free_svalue(svp);
|
|
} while (--i > 0);
|
|
|
|
/* Deallocate the block */
|
|
xfree(arg);
|
|
|
|
} /* f_walk_mapping_cleanup() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
static svalue_t *
|
|
walk_mapping_prologue (mapping_t *m, svalue_t *sp, callback_t *cb)
|
|
|
|
/* Auxiliary to efuns {walk,filter}_walk_mapping(): Setup.
|
|
*
|
|
* The function creates an svalue array of the keys and (as lvalues) the
|
|
* data values of mapping <m>. The head of the array holds organisational
|
|
* information; the array as a whole is put as lvalue onto the stack
|
|
* at <sp>+1.
|
|
*
|
|
* The result configuration of the array is:
|
|
*
|
|
* sp+1 -> [0] { lvalue } -> { T_ERROR_HANDLER: f_walk_mapping_cleanup }
|
|
* [1] { u.cb: callback structure }
|
|
* [2] { u.number: number of mapping entries }
|
|
* [3] { u.map: <m>, x.generic: <m> has hash part }
|
|
* result -> [4] { key1 }
|
|
* [5] { lvalue } -> values of key1
|
|
* [6] { key2 }
|
|
* [7] { lvalue } -> values of key2
|
|
* etc
|
|
*
|
|
* Storing the array as error handler allows a simple cleanup in course
|
|
* of the free_svalue()s done by f_walk_mapping().
|
|
*
|
|
* If <m> at call time has a hash part, it is protected by incrementing
|
|
* hash->ref.
|
|
*/
|
|
|
|
{
|
|
mapping_hash_t *hm;
|
|
svalue_t *pointers;
|
|
svalue_t *write_pointer, *read_pointer;
|
|
|
|
if ( NULL != (hm = m->hash) ) {
|
|
if (m->num_values == 0)
|
|
{
|
|
hm = NULL; /* Flag: no values per key */
|
|
}
|
|
else if (!hm->ref++)
|
|
{
|
|
hm->deleted = NULL;
|
|
}
|
|
}
|
|
xallocate(pointers, (m->num_entries * 2 + 4) * sizeof(svalue_t)
|
|
, "walk_mapping prologue" );
|
|
pointers[1].type = T_CALLBACK;
|
|
pointers[1].u.cb = cb;
|
|
pointers[2].u.number = m->num_entries;
|
|
pointers[3].u.map = m;
|
|
pointers[3].x.generic = hm != NULL;
|
|
inter_sp = sp;
|
|
push_error_handler(f_walk_mapping_cleanup, pointers);
|
|
read_pointer = write_pointer = pointers + 4;
|
|
walk_mapping(m, f_walk_mapping_filter, &write_pointer);
|
|
return read_pointer;
|
|
} /* walk_mapping_prologue() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
v_walk_mapping (svalue_t *sp, int num_arg)
|
|
|
|
/* EFUN walk_mapping()
|
|
*
|
|
* void walk_mapping(mapping m, string func, string|object ob, mixed extra,...)
|
|
* void walk_mapping(mapping m, closure cl, mixed extra,...)
|
|
*
|
|
* Calls ob->func(key, value1, ..., valueN, extra,...) resp. applies
|
|
* the closure to every entry in the mapping. The keys are passed
|
|
* by value, the values are passed by reference and can be
|
|
* changed in the function.
|
|
* Any number of extra arguments is accepted and passed.
|
|
* If <ob> is omitted, or neither an object nor a string, then
|
|
* this_object() is used.
|
|
*/
|
|
|
|
{
|
|
svalue_t *arg; /* Begin of the args on the stack */
|
|
callback_t cb;
|
|
int error_index;
|
|
mapping_t *m; /* Mapping to walk */
|
|
p_int num_values; /* Number of values per entry */
|
|
svalue_t *read_pointer; /* Prepared mapping values */
|
|
mp_int i;
|
|
|
|
/* Locate the arguments on the stack and extract them */
|
|
arg = sp - num_arg + 1;
|
|
inter_sp = sp;
|
|
|
|
error_index = setup_efun_callback(&cb, arg+1, num_arg-1);
|
|
inter_sp = sp = arg;
|
|
num_arg = 1;
|
|
|
|
if (error_index >= 0)
|
|
{
|
|
vefun_bad_arg(error_index+2, sp);
|
|
/* NOTREACHED */
|
|
return sp;
|
|
}
|
|
|
|
m = arg[0].u.map;
|
|
|
|
|
|
/* Preparations */
|
|
|
|
check_map_for_destr(m);
|
|
assign_eval_cost();
|
|
|
|
read_pointer = walk_mapping_prologue(m, sp, &cb);
|
|
i = read_pointer[-2].u.number;
|
|
inter_sp = ++sp; /* walk_mapping_prologue() pushed one value */
|
|
|
|
num_values = m->num_values;
|
|
|
|
/* For every key:values pair in read_pointer[], set up
|
|
* the stack for a call to the walk function.
|
|
*/
|
|
while (--i >= 0)
|
|
{
|
|
p_int j;
|
|
svalue_t *sp2, *data;
|
|
|
|
if (!callback_object(&cb))
|
|
errorf("Object used by walk_mapping destructed\n");
|
|
|
|
/* Push the key */
|
|
assign_svalue_no_free( (sp2 = sp+1), read_pointer++ );
|
|
|
|
/* Push the values as lvalues */
|
|
for (j = num_values, data = (read_pointer++)->u.lvalue; --j >= 0; )
|
|
{
|
|
(++sp2)->type = T_LVALUE;
|
|
sp2->u.lvalue = data++;
|
|
}
|
|
|
|
/* Call the function */
|
|
inter_sp = sp2;
|
|
(void)apply_callback(&cb, 1 + num_values);
|
|
}
|
|
|
|
/* This frees the whole array allocated by the prologue,
|
|
* including the data held by the callback.
|
|
*/
|
|
free_svalue(sp);
|
|
|
|
/* Free the arguments */
|
|
i = num_arg;
|
|
do
|
|
free_svalue(--sp);
|
|
while (--i > 0);
|
|
|
|
return sp-1;
|
|
} /* v_walk_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
x_filter_mapping (svalue_t *sp, int num_arg, Bool bFull)
|
|
|
|
/* EFUN filter() on mappings, filter_mapping() == filter_indices()
|
|
*
|
|
* mapping filter_mapping(mapping, string func, string|object ob, ...)
|
|
* mapping filter_mapping(mapping, closure cl, ...)
|
|
*
|
|
* mapping filter(mapping, string func, string|object ob, ...)
|
|
* mapping filter(mapping, closure cl, ...)
|
|
*
|
|
* ob->func() is called resp. cl applied to every element in the
|
|
* mapping, with the key of the element as first argument, optionally
|
|
* the data for the key as second argument (if bFull is TRUE), and
|
|
* then the extra args that were given to the efun. If the function
|
|
* returns true, the element is added to the result mapping.
|
|
*
|
|
* If <ob> is omitted, or neither an object nor a string, then
|
|
* this_object() is used.
|
|
*
|
|
* If the data for the key is passed, it can take one of the following
|
|
* forms:
|
|
* widthof(m) == 0: nothing is passed
|
|
* widthof(m) == 1: m[key] is passed
|
|
* widthof(m) > 1: ({ m[key,0] .. m[key,width-1] }) is passed
|
|
*/
|
|
|
|
{
|
|
svalue_t *arg; /* Start of arguments on the stack */
|
|
mapping_t *m; /* Mapping to filter */
|
|
int error_index;
|
|
callback_t cb;
|
|
p_int num_values; /* Width of the mapping */
|
|
vector_t *dvec; /* Values of one key */
|
|
svalue_t *dvec_sp; /* Stackentry of dvec */
|
|
svalue_t *read_pointer; /* Prepared mapping values */
|
|
svalue_t *v;
|
|
p_int i, j;
|
|
|
|
/* Locate the arguments on the stack and extract them */
|
|
arg = sp - num_arg + 1;
|
|
|
|
error_index = setup_efun_callback(&cb, arg+1, num_arg-1);
|
|
inter_sp = sp = arg;
|
|
num_arg = 1;
|
|
|
|
if (error_index >= 0)
|
|
{
|
|
vefun_bad_arg(error_index+2, sp);
|
|
/* NOTREACHED */
|
|
return sp;
|
|
}
|
|
|
|
m = arg[0].u.map;
|
|
|
|
/* Preparations */
|
|
|
|
check_map_for_destr(m);
|
|
assign_eval_cost();
|
|
|
|
num_values = m->num_values;
|
|
|
|
/* Prepare the vector for the values of each element */
|
|
dvec = NULL;
|
|
dvec_sp = NULL;
|
|
bFull = bFull ? 1 : 0;
|
|
/* So we can use it as the number of extra arguments */
|
|
|
|
if (bFull && num_values > 1)
|
|
{
|
|
dvec = allocate_array(num_values);
|
|
if (!dvec)
|
|
{
|
|
inter_sp = sp;
|
|
free_callback(&cb);
|
|
errorf("Out of memory\n");
|
|
}
|
|
++sp;
|
|
put_array(sp, dvec);
|
|
dvec_sp = sp;
|
|
}
|
|
|
|
read_pointer = walk_mapping_prologue(m, sp, &cb);
|
|
|
|
m = allocate_mapping(read_pointer[-2].u.number, num_values);
|
|
if (!m)
|
|
{
|
|
inter_sp = sp + 1;
|
|
errorf("Out of memory\n");
|
|
}
|
|
sp += 2;
|
|
put_mapping(sp, m);
|
|
|
|
/* m and dvec are kept referenced on the stack so that
|
|
* in case of an error it is properly dereferenced.
|
|
* At a normal termination however, m will not be dereferenced.
|
|
*/
|
|
|
|
/* For every (key:values) in read_pointer[], set up the stack for
|
|
* a call to the filter function. If it returns true, assign the
|
|
* pair to the new mapping.
|
|
*/
|
|
for (i = read_pointer[-2].u.number; --i >= 0; read_pointer += 2)
|
|
{
|
|
svalue_t *data;
|
|
|
|
/* Check if somebody took a reference to the old dvec.
|
|
* If yes, we need to create a new one.
|
|
*/
|
|
if (dvec != NULL && dvec->ref > 1)
|
|
{
|
|
free_array(dvec);
|
|
dvec = allocate_array(num_values);
|
|
if (!dvec)
|
|
{
|
|
put_number(dvec_sp, 0);
|
|
inter_sp = sp;
|
|
free_callback(&cb);
|
|
errorf("Out of memory\n");
|
|
}
|
|
else
|
|
put_array(dvec_sp, dvec);
|
|
}
|
|
|
|
/* Push the key */
|
|
assign_svalue_no_free((inter_sp = sp + 1), read_pointer);
|
|
|
|
if (bFull) /* Push the data */
|
|
{
|
|
if (num_values == 0)
|
|
{
|
|
push_number(inter_sp, 0);
|
|
}
|
|
else if (1 == num_values)
|
|
{
|
|
push_svalue(read_pointer[1].u.lvalue);
|
|
}
|
|
else
|
|
{
|
|
svalue_t *svp;
|
|
|
|
v = read_pointer[1].u.lvalue;
|
|
for (j = 0, svp = dvec->item
|
|
; j < num_values
|
|
; j++, svp++, v++)
|
|
assign_svalue(svp, v);
|
|
push_svalue(dvec_sp);
|
|
}
|
|
}
|
|
|
|
if (!callback_object(&cb))
|
|
errorf("Object used by %s destructed"
|
|
, bFull ? "filter" : "filter_mapping");
|
|
|
|
|
|
v = apply_callback(&cb, 1 + bFull);
|
|
|
|
/* Did the filter return TRUE? */
|
|
if (!v || (v->type == T_NUMBER && !v->u.number) )
|
|
continue;
|
|
|
|
/* If we come here, the filter function returned 'true'.
|
|
* Therefore assign the pair to the new mapping.
|
|
*/
|
|
v = get_map_lvalue_unchecked(m, read_pointer);
|
|
if (!v)
|
|
{
|
|
outofmemory("filtered entry");
|
|
/* NOTREACHED */
|
|
return NULL;
|
|
}
|
|
for (j = num_values, data = read_pointer[1].u.lvalue; --j >= 0; )
|
|
{
|
|
assign_svalue_no_free(v++, data++);
|
|
}
|
|
}
|
|
|
|
/* Cleanup the temporary data except for the reference to m.
|
|
* The arguments have been removed before already.
|
|
*/
|
|
free_callback(&cb);
|
|
i = num_arg + (dvec != NULL ? 1 : 0);
|
|
do
|
|
{
|
|
free_svalue(--sp);
|
|
}
|
|
while (--i >= 0);
|
|
|
|
/* Return the result mapping in place of the argument mapping.
|
|
*/
|
|
put_mapping(sp, m);
|
|
|
|
return sp;
|
|
} /* x_filter_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
v_filter_indices (svalue_t *sp, int num_arg)
|
|
|
|
/* EFUN filter_indices()
|
|
*
|
|
* mapping filter_indices(mapping, string func, string|object ob, ...)
|
|
* mapping filter_indices(mapping, closure cl, ...)
|
|
*
|
|
* ob->func() is called resp. cl applied to every element in the
|
|
* mapping, with first argument being the key of the
|
|
* element, and then the extra args that were given to
|
|
* filter_mapping. If the function returns true, the element is
|
|
* added to the result mapping. ob can also be a file_name of an
|
|
* object.
|
|
* If <ob> is omitted, or neither an object nor a string, then
|
|
* this_object() is used.
|
|
*/
|
|
|
|
{
|
|
return x_filter_mapping(sp, num_arg, MY_FALSE);
|
|
} /* v_filter_indices() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
x_map_mapping (svalue_t *sp, int num_arg, Bool bFull)
|
|
|
|
/* EFUN map() on mappings, map_indices()
|
|
*
|
|
* mapping map_mapping(mapping m, string func, object ob, ...)
|
|
* mapping map_mapping(mapping m, closure cl, ...)
|
|
*
|
|
* mapping map(mapping m, string func, string|object ob, ...)
|
|
* mapping map(mapping m, closure cl, ...)
|
|
*
|
|
* ob->func() is called resp. cl applied to every element in the
|
|
* mapping, with the key of the element as first argument, optionally
|
|
* the data for the key as second argument (if bFull is TRUE), and
|
|
* then the extra args that were given to the efun.
|
|
*
|
|
* If <ob> is omitted, or neither an object nor a string, then
|
|
* this_object() is used.
|
|
*
|
|
* If the data for the key is passed, it can take one of the following
|
|
* forms:
|
|
* widthof(m) == 0: nothing is passed
|
|
* widthof(m) == 1: m[key] is passed
|
|
* widthof(m) > 1: ({ m[key,0] .. m[key,width-1] }) is passed
|
|
*
|
|
* The data item in the result mapping is set to the return value
|
|
* of the function. ob can also be a file_name of an object.
|
|
* If the second arg is a string and the third is not an
|
|
* object, this_object() will be used as default.
|
|
*
|
|
* Note that if mapping m has more than one value per key, these
|
|
* are ignored: the resulting mapping always has one value per key.
|
|
*
|
|
* Also note that the behaviour of this function is different from
|
|
* map_array().
|
|
*/
|
|
|
|
{
|
|
svalue_t *arg; /* Begin of arguments on the stack */
|
|
mapping_t *arg_m; /* Mapping to map */
|
|
mapping_t *m; /* Result mapping */
|
|
p_int num_values; /* Width of the mapping */
|
|
vector_t *vec; /* Indices of m */
|
|
svalue_t *dvec_sp; /* Stackentry of dvec */
|
|
vector_t *dvec; /* Values of one key */
|
|
p_int i;
|
|
svalue_t *key;
|
|
callback_t cb;
|
|
int error_index;
|
|
|
|
/* Locate and extract arguments */
|
|
arg = sp - num_arg + 1;
|
|
inter_sp = sp;
|
|
|
|
error_index = setup_efun_callback(&cb, arg+1, num_arg-1);
|
|
inter_sp = sp = arg;
|
|
num_arg = 2;
|
|
|
|
if (error_index >= 0)
|
|
{
|
|
vefun_bad_arg(error_index+2, sp);
|
|
/* NOTREACHED */
|
|
return sp;
|
|
}
|
|
|
|
sp++;
|
|
inter_sp = sp;
|
|
put_callback(sp, &cb);
|
|
|
|
/* Preparations */
|
|
|
|
arg_m = arg[0].u.map;
|
|
|
|
assign_eval_cost();
|
|
|
|
num_values = arg_m->num_values;
|
|
|
|
/* Get the indices of arg_m */
|
|
vec = m_indices(arg_m); /* might cause error */
|
|
++sp;
|
|
put_array(sp, vec);
|
|
|
|
/* Prepare the vector for the values of each element */
|
|
dvec = NULL;
|
|
dvec_sp = NULL;
|
|
bFull = bFull ? 1 : 0;
|
|
/* So we can use it as the number of extra arguments */
|
|
|
|
if (bFull && num_values > 1)
|
|
{
|
|
dvec = allocate_array(num_values);
|
|
if (!dvec)
|
|
{
|
|
inter_sp = sp;
|
|
errorf("Out of memory\n");
|
|
}
|
|
++sp;
|
|
put_array(sp, dvec);
|
|
dvec_sp = sp;
|
|
}
|
|
|
|
m = allocate_mapping((i = VEC_SIZE(vec)), 1);
|
|
if (!m)
|
|
{
|
|
inter_sp = sp;
|
|
errorf("Out of memory\n");
|
|
}
|
|
++sp;
|
|
put_mapping(sp, m);
|
|
|
|
/* Both cb, vec, dvec and m are kept referenced on the stack so that
|
|
* in case of an error they are properly dereferenced.
|
|
* At a normal termination however, m will not be dereferenced
|
|
* but cb, vec and dvec will.
|
|
*/
|
|
|
|
key = vec->item;
|
|
for (; --i >= 0; key++) {
|
|
svalue_t *v;
|
|
svalue_t *data;
|
|
|
|
/* Check if somebody took a reference to the old dvec.
|
|
* If yes, we need to create a new one.
|
|
*/
|
|
if (dvec != NULL && dvec->ref > 1)
|
|
{
|
|
free_array(dvec);
|
|
dvec = allocate_array(num_values);
|
|
if (!dvec)
|
|
{
|
|
put_number(dvec_sp, 0);
|
|
inter_sp = sp;
|
|
errorf("Out of memory\n");
|
|
}
|
|
else
|
|
put_array(dvec_sp, dvec);
|
|
}
|
|
|
|
/* Push the key */
|
|
assign_svalue_no_free((inter_sp = sp + 1), key);
|
|
|
|
if (bFull) /* Push the data */
|
|
{
|
|
if (0 == num_values)
|
|
push_number(inter_sp, 0);
|
|
else if (1 == num_values)
|
|
{
|
|
v = get_map_value(arg_m, key);
|
|
push_svalue(v);
|
|
}
|
|
else
|
|
{
|
|
p_int j;
|
|
svalue_t *svp;
|
|
|
|
v = get_map_value(arg_m, key);
|
|
for (j = 0, svp = dvec->item; j < num_values; j++, svp++, v++)
|
|
assign_svalue(svp, v);
|
|
push_svalue(dvec_sp);
|
|
}
|
|
}
|
|
|
|
/* Call the filter function */
|
|
v = get_map_lvalue_unchecked(m, key);
|
|
if (!v)
|
|
{
|
|
outofmemory("mapped entry");
|
|
/* NOTREACHED */
|
|
return NULL;
|
|
}
|
|
|
|
if (!callback_object(&cb))
|
|
errorf("Object used by %s destructed"
|
|
, bFull ? "map" : "map_mapping");
|
|
|
|
data = apply_callback(&cb, 1 + bFull);
|
|
if (data)
|
|
{
|
|
transfer_svalue_no_free(v, data);
|
|
data->type = T_INVALID;
|
|
}
|
|
}
|
|
|
|
/* Cleanup the temporary data except for the reference to m.
|
|
* The arguments have been removed before already.
|
|
*/
|
|
i = num_arg + (dvec != NULL ? 1 : 0);
|
|
do
|
|
{
|
|
free_svalue(--sp);
|
|
}
|
|
while (--i >= 0);
|
|
|
|
/* Return the result mapping in place of the argument mapping.
|
|
*/
|
|
put_mapping(sp, m);
|
|
return sp;
|
|
} /* x_map_mapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
v_map_indices (svalue_t *sp, int num_arg)
|
|
|
|
/* VEFUN map_indices()
|
|
*
|
|
* mapping map_indices(mapping m, string func, object ob, ...)
|
|
* mapping map_indices(mapping m, closure cl, ...)
|
|
*
|
|
* ob->func() is called resp. cl applied to every element in the
|
|
* mapping, with the key of the element as first argument, and
|
|
* then the extra args that were given to map_mapping.
|
|
* The data item in the mapping is replaced by the return value
|
|
* of the function. ob can also be a file_name of an object.
|
|
*
|
|
* If <ob> is omitted, or neither an object nor a string, then
|
|
* this_object() is used.
|
|
*/
|
|
|
|
{
|
|
return x_map_mapping(sp, num_arg, MY_FALSE);
|
|
} /* v_map_indices() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
v_m_contains (svalue_t *sp, int num_arg)
|
|
|
|
/* EFUN m_contains()
|
|
*
|
|
* int m_contains(mixed &data1, ..., &dataN, map, key)
|
|
*
|
|
* If the mapping contains the key map, the corresponding values
|
|
* are assigned to the data arguments, which must be passed by
|
|
* reference, and 1 is returned. If key is not in map, 0 is
|
|
* returned and the data args are left unchanged.
|
|
* It is possible to use this function for a 0-value mapping, in
|
|
* which case it has the same effect as member(E).
|
|
*/
|
|
|
|
{
|
|
svalue_t *item;
|
|
int i;
|
|
|
|
/* Test the arguments */
|
|
for (i = -num_arg; ++i < -1; )
|
|
if (sp[i].type != T_LVALUE)
|
|
vefun_arg_error(num_arg + i, T_LVALUE, sp[i].type, sp);
|
|
if (sp[-1].type != T_MAPPING)
|
|
vefun_arg_error(num_arg-1, T_MAPPING, sp[-1].type, sp);
|
|
if (sp[-1].u.map->num_values != num_arg - 2)
|
|
errorf("Not enough lvalues: given %d, required %"PRIdPINT".\n",
|
|
num_arg-2, sp[-1].u.map->num_values);
|
|
|
|
item = get_map_value(sp[-1].u.map, sp);
|
|
if (item == &const0)
|
|
{
|
|
/* Not found */
|
|
sp = pop_n_elems(num_arg-1, sp);
|
|
free_svalue(sp);
|
|
put_number(sp, 0);
|
|
return sp;
|
|
}
|
|
|
|
free_svalue(sp--); /* free key */
|
|
|
|
/* Copy the elements */
|
|
for (i = -num_arg + 1; ++i < 0; )
|
|
{
|
|
/* get_map_lvalue() may return destructed objects. */
|
|
/* TODO: May this cause problems elsewhere, too? */
|
|
if (destructed_object_ref(item))
|
|
{
|
|
assign_svalue(sp[i].u.lvalue, &const0);
|
|
item++;
|
|
}
|
|
else
|
|
/* mapping must not have been freed yet */
|
|
assign_svalue(sp[i].u.lvalue, item++);
|
|
free_svalue(&sp[i]);
|
|
}
|
|
|
|
free_svalue(sp--); /* free mapping */
|
|
sp += 3 - num_arg;
|
|
put_number(sp, 1);
|
|
|
|
return sp;
|
|
} /* v_m_contains() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
f_m_entry (svalue_t *sp)
|
|
|
|
/* TEFUN m_entry()
|
|
*
|
|
* mixed * m_entry (mapping m, mixed key)
|
|
*
|
|
* Query the mapping <m> for key <key> and return all values for this
|
|
* key as array.
|
|
* If the mapping does not contain an entry for <key>, svalue-0 is
|
|
* returned.
|
|
*/
|
|
|
|
{
|
|
svalue_t * data;
|
|
vector_t * rc;
|
|
|
|
data = get_map_value(sp[-1].u.map, sp);
|
|
if (&const0 != data)
|
|
{
|
|
p_int num_values = sp[-1].u.map->num_values;
|
|
p_int i;
|
|
|
|
rc = allocate_array(num_values);
|
|
|
|
for (i = 0; i < num_values; i++)
|
|
{
|
|
assign_svalue(rc->item+i, data+i);
|
|
}
|
|
}
|
|
else
|
|
rc = NULL;
|
|
|
|
free_svalue(sp); sp--;
|
|
free_svalue(sp);
|
|
|
|
if (rc)
|
|
put_array(sp, rc);
|
|
else
|
|
put_number(sp, 0);
|
|
|
|
return sp;
|
|
} /* f_m_entry() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
f_m_reallocate (svalue_t *sp)
|
|
|
|
/* EFUN m_reallocate()
|
|
*
|
|
* mapping m_reallocate(mapping m, int width)
|
|
*
|
|
* Create a new mapping of width <width> and fill it with the values
|
|
* of mapping <m>. If <m> is narrower than <width>, the extra values
|
|
* in the result will be 0; if <m> is wider, the extra values of <m>
|
|
* will be omitted.
|
|
*/
|
|
|
|
{
|
|
p_int new_width; /* Requested width of the target mapping */
|
|
mapping_t *m; /* Argument mapping */
|
|
mapping_t *new_m; /* New mapping */
|
|
|
|
/* Test and get arguments */
|
|
new_width = sp->u.number;
|
|
if (new_width < 0)
|
|
{
|
|
errorf("Illegal width to m_reallocate(): %"PRIdPINT"\n", new_width);
|
|
/* NOTREACHED */
|
|
return sp;
|
|
}
|
|
|
|
inter_sp = --sp;
|
|
|
|
m = sp->u.map;
|
|
|
|
/* Resize the mapping */
|
|
check_map_for_destr(m);
|
|
new_m = resize_mapping(m, new_width);
|
|
if (!new_m)
|
|
{
|
|
errorf("Out of memory.\n");
|
|
/* NOTREACHED */
|
|
return sp;
|
|
}
|
|
|
|
/* Assign and return the result */
|
|
free_svalue(sp);
|
|
put_mapping(sp, new_m);
|
|
|
|
return sp;
|
|
} /* f_m_reallocate() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
v_mkmapping (svalue_t *sp, int num_arg)
|
|
|
|
/* EFUN mkmapping()
|
|
*
|
|
* mapping mkmapping(mixed *arr1, mixed *arr2,...)
|
|
*
|
|
* Returns a mapping with indices from 'arr1' and values from
|
|
* 'arr2'... . arr1[0] will index arr2...[0], arr1[1] will index
|
|
* arr2...[1], etc. If the arrays are of unequal size, the mapping
|
|
* will only contain as much elements as are in the smallest
|
|
* array.
|
|
*
|
|
#ifdef USE_STRUCTS
|
|
* mapping mkmapping(struct st)
|
|
*
|
|
* Return a mapping with all values from struct <st>, indexed by
|
|
* the struct's member names.
|
|
#endif
|
|
*/
|
|
|
|
{
|
|
mapping_t *m;
|
|
|
|
m = NULL;
|
|
|
|
#ifdef USE_STRUCTS
|
|
if (sp[-num_arg+1].type == T_STRUCT)
|
|
{
|
|
struct_t * st;
|
|
long i, length;
|
|
|
|
/* Check the arguments and determine the mapping length.
|
|
*/
|
|
if (num_arg > 1)
|
|
errorf("Too many arguments to mkmapping(): expected struct\n");
|
|
|
|
st = sp->u.strct;
|
|
length = struct_size(st);
|
|
|
|
if (max_mapping_size && length > (p_int)max_mapping_size)
|
|
errorf("Illegal mapping size: %ld elements\n", length);
|
|
if (max_mapping_keys && length > (p_int)max_mapping_keys)
|
|
errorf("Illegal mapping size: %ld entries\n", length);
|
|
|
|
/* Allocate the mapping and assign the values */
|
|
m = allocate_mapping(length, 1);
|
|
if (!m)
|
|
errorf("Out of memory\n");
|
|
|
|
for (i = 0; i < length; i++)
|
|
{
|
|
svalue_t key;
|
|
svalue_t * data;
|
|
|
|
put_string(&key, st->type->member[i].name);
|
|
data = get_map_lvalue_unchecked(m, &key);
|
|
assign_svalue(data, &st->member[i]);
|
|
}
|
|
}
|
|
#endif
|
|
|
|
if (sp[-num_arg+1].type == T_POINTER)
|
|
{
|
|
int i, num_values; /* contains num_arg, which is int */
|
|
p_int length; /* VEC_SIZE, array sizes */
|
|
svalue_t *key;
|
|
|
|
/* Check the arguments and set length to the size of
|
|
* the shortest array.
|
|
*/
|
|
length = PINT_MAX;
|
|
for (i = -num_arg; ++i <= 0; )
|
|
{
|
|
if ( sp[i].type != T_POINTER )
|
|
vefun_arg_error(i+num_arg, T_POINTER, sp[i].type, sp);
|
|
if (length > VEC_SIZE(sp[i].u.vec))
|
|
length = VEC_SIZE(sp[i].u.vec);
|
|
}
|
|
|
|
if (max_mapping_size && (mp_int)length * num_arg > (mp_int)max_mapping_size)
|
|
errorf("Illegal mapping size: %"PRIdMPINT
|
|
" elements (%"PRIdPINT" x %d)\n"
|
|
, (mp_int)length * num_arg, length, num_arg);
|
|
if (max_mapping_keys && length > (p_int)max_mapping_keys)
|
|
errorf("Illegal mapping size: %"PRIdPINT" entries\n", length);
|
|
|
|
/* Allocate the mapping */
|
|
num_values = num_arg - 1;
|
|
m = allocate_mapping(length, num_values);
|
|
if (!m)
|
|
errorf("Out of memory\n");
|
|
|
|
/* Shift key through the first array and assign the values
|
|
* from the others.
|
|
*/
|
|
key = &(sp-num_values)->u.vec->item[length];
|
|
while (--length >= 0)
|
|
{
|
|
svalue_t *dest;
|
|
|
|
dest = get_map_lvalue_unchecked(m, --key);
|
|
if (!dest)
|
|
{
|
|
outofmemory("new mapping entry");
|
|
/* NOTREACHED */
|
|
return NULL;
|
|
}
|
|
for (i = -num_values; ++i <= 0; )
|
|
{
|
|
/* If a key value appears multiple times, we have to free
|
|
* a previous assigned value to avoid a memory leak
|
|
*/
|
|
assign_svalue(dest++, &sp[i].u.vec->item[length]);
|
|
}
|
|
}
|
|
}
|
|
|
|
/* If m is NULL at this point, we got an illegal argument */
|
|
if (m == NULL)
|
|
{
|
|
fatal("Illegal argument to mkmapping(): %s, expected array/struct.\n"
|
|
, typename(sp[-num_arg+1].type));
|
|
}
|
|
|
|
/* Clean up the stack and push the result */
|
|
sp = pop_n_elems(num_arg, sp);
|
|
push_mapping(sp, m);
|
|
|
|
return sp;
|
|
} /* v_mkmapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
f_unmkmapping (svalue_t *sp)
|
|
|
|
/* EFUN unmkmapping()
|
|
*
|
|
* mixed* unmkmapping(mapping map)
|
|
*
|
|
* Take mapping <map> and return an array of arrays with the keys
|
|
* and values from the mapping.
|
|
*
|
|
* The return array has the form ({ keys[], data0[], data1[], ... }).
|
|
*/
|
|
|
|
{
|
|
svalue_t *svp;
|
|
mapping_t *m;
|
|
vector_t *v;
|
|
struct mvf_info vip;
|
|
mp_int size;
|
|
p_int i;
|
|
|
|
/* Get the arguments */
|
|
m = sp->u.map;
|
|
|
|
/* Determine the size of the mapping and allocate the result vector */
|
|
check_map_for_destr(m);
|
|
size = MAP_SIZE(m);
|
|
v = allocate_array(m->num_values+1);
|
|
|
|
/* Allocate the sub vectors */
|
|
for (i = 0, svp = v->item; i <= m->num_values; i++, svp++)
|
|
{
|
|
vector_t *v2;
|
|
|
|
v2 = allocate_array(size);
|
|
put_array(svp, v2);
|
|
}
|
|
|
|
/* Copy the elements from the mapping into the vector brush */
|
|
vip.svp = v->item;
|
|
vip.num = 0;
|
|
vip.width = m->num_values;
|
|
walk_mapping(m, m_unmake_filter, &vip);
|
|
|
|
/* Clean up the stack and push the result */
|
|
free_mapping(m);
|
|
put_array(sp,v);
|
|
|
|
return sp;
|
|
} /* f_unmkmapping() */
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
svalue_t *
|
|
f_widthof (svalue_t *sp)
|
|
|
|
/* EFUN widthof()
|
|
*
|
|
* int widthof (mapping map)
|
|
*
|
|
* Returns the number of values per key of mapping <map>.
|
|
* If <map> is 0, the result is 0.
|
|
*/
|
|
|
|
{
|
|
p_int width;
|
|
|
|
if (sp->type == T_NUMBER && sp->u.number == 0)
|
|
return sp;
|
|
|
|
if (sp->type != T_MAPPING)
|
|
efun_arg_error(1, T_MAPPING, sp->type, sp);
|
|
|
|
width = sp->u.map->num_values;
|
|
free_mapping(sp->u.map);
|
|
put_number(sp, width);
|
|
|
|
return sp;
|
|
} /* f_widthof() */
|
|
|
|
/***************************************************************************/
|