void RetypeBag(Bag bag, UInt new_type)
{
BagHeader * header = BAG_HEADER(bag);
UInt old_type = header->type;
/* change the size-type word */
header->type = new_type;
{
int old_gctype, new_gctype;
UInt size;
void *new_mem, *old_mem;
old_gctype = TabMarkTypeBags[old_type];
new_gctype = TabMarkTypeBags[new_type];
if (old_gctype != new_gctype) {
size = SIZE_BAG(bag) + sizeof(BagHeader);
new_mem = AllocateBagMemory(new_gctype, new_type, size);
old_mem = PTR_BAG(bag);
old_mem = ((char *)old_mem) - sizeof(BagHeader);
memcpy(new_mem, old_mem, size);
SET_PTR_BAG(bag, (void *)(((char *)new_mem) + sizeof(BagHeader)));
}
}
#ifdef HPCGAP
switch (DSInfoBags[new_type]) {
case DSI_PUBLIC:
REGION(bag) = NULL;
break;
}
#endif // HPCGAP
}
/****************************************************************************
**
*F FuncADD_SET( <self>, <set>, <obj> ) . . . . . . . add an element to a set
**
** 'FuncADD_SET' implements the internal function 'AddSet'.
**
** 'AddSet( <set>, <obj> )'
**
** 'AddSet' adds <obj>, which may be an object of an arbitrary type, to the
** set <set>, which must be a proper set. If <obj> is already an element of
** the set <set>, then <set> is not changed. Otherwise <obj> is inserted at
** the correct position such that <set> is again a set afterwards.
**
** 'AddSet' does not return anything, it is only called for the side effect
** of changing <set>.
*/
Obj FuncADD_SET (
Obj self,
Obj set,
Obj obj )
{
UInt len; /* logical length of the list */
UInt pos; /* position */
UInt isCyc; /* True if the set being added to consists
of kernel cyclotomics */
UInt notpos; /* position of an original element
(not the new one) */
UInt wasHom;
UInt wasNHom;
UInt wasTab;
/* check the arguments */
while ( ! IsSet(set) || ! IS_MUTABLE_OBJ(set) ) {
set = ErrorReturnObj(
"AddSet: <set> must be a mutable proper set (not a %s)",
(Int)TNAM_OBJ(set), 0L,
"you can replace <set> via 'return <set>;'" );
}
len = LEN_LIST(set);
/* perform the binary search to find the position */
pos = PositionSortedDensePlist( set, obj );
/* add the element to the set if it is not already there */
if ( len < pos || ! EQ( ELM_PLIST(set,pos), obj ) ) {
GROW_PLIST( set, len+1 );
SET_LEN_PLIST( set, len+1 );
{
Obj *ptr;
ptr = PTR_BAG(set);
memmove((void *)(ptr + pos+1),(void*)(ptr+pos),(size_t)(sizeof(Obj)*(len+1-pos)));
#if 0
for ( i = len+1; pos < i; i-- ) {
*ptr = *(ptr-1);
ptr--; */
/* SET_ELM_PLIST( set, i, ELM_PLIST(set,i-1) ); */
}
#endif
}
SET_ELM_PLIST( set, pos, obj );
CHANGED_BAG( set );
/* fix up the type of the result */
if ( HAS_FILT_LIST( set, FN_IS_SSORT ) ) {
isCyc = (TNUM_OBJ(set) == T_PLIST_CYC_SSORT);
wasHom = HAS_FILT_LIST(set, FN_IS_HOMOG);
wasTab = HAS_FILT_LIST(set, FN_IS_TABLE);
wasNHom = HAS_FILT_LIST(set, FN_IS_NHOMOG);
CLEAR_FILTS_LIST(set);
/* the result of addset is always dense */
SET_FILT_LIST( set, FN_IS_DENSE );
/* if the object we added was not
mutable then we might be able to
conclude more */
if ( ! IS_MUTABLE_OBJ(obj) ) {
/* a one element list is automatically
homogenous and ssorted */
if (len == 0 )
{
if (TNUM_OBJ(obj) <= T_CYC)
RetypeBag( set, T_PLIST_CYC_SSORT);
else
{
SET_FILT_LIST( set, FN_IS_HOMOG );
SET_FILT_LIST( set, FN_IS_SSORT );
if (IS_HOMOG_LIST(obj)) /* it might be a table */
SET_FILT_LIST( set, FN_IS_TABLE );
}
}
else
{
/* Now determine homogeneity */
if (isCyc)
if (TNUM_OBJ(obj) <= T_CYC)
RetypeBag( set, T_PLIST_CYC_SSORT);
else
{
RESET_FILT_LIST(set, FN_IS_HOMOG);
SET_FILT_LIST(set, FN_IS_NHOMOG);
}
else if (wasHom)
{
if (!SyInitializing) {
notpos = (pos == 1) ? 2 : 1;
if (FAMILY_OBJ(ELM_PLIST(set,notpos)) == FAMILY_OBJ(obj))
{
SET_FILT_LIST(set, FN_IS_HOMOG);
if (wasTab) {
if (IS_HOMOG_LIST( obj ))
SET_FILT_LIST(set, FN_IS_TABLE);
}
}
else
SET_FILT_LIST(set, FN_IS_NHOMOG);
}
}
else if (wasNHom)
SET_FILT_LIST(set, FN_IS_NHOMOG);
}
}
SET_FILT_LIST( set, FN_IS_SSORT );
}
else {
CLEAR_FILTS_LIST(set);
SET_FILT_LIST( set, FN_IS_DENSE );
}
}
UInt ResizeBag(Bag bag, UInt new_size)
{
UInt type; /* type of the bag */
UInt flags;
UInt old_size; /* old size of the bag */
Bag * src; /* source in copying */
UInt alloc_size;
/* check the size */
#ifdef TREMBLE_HEAP
CollectBags(0, 0);
#endif
BagHeader * header = BAG_HEADER(bag);
/* get type and old size of the bag */
type = header->type;
flags = header->flags;
old_size = header->size;
#ifdef COUNT_BAGS
/* update the statistics */
InfoBags[type].sizeLive += new_size - old_size;
InfoBags[type].sizeAll += new_size - old_size;
#endif
SizeAllBags += new_size - old_size;
#ifndef DISABLE_GC
alloc_size = GC_size(header);
/* An alternative implementation would be to compare
* new_size <= alloc_size in the following test in order
* to avoid reallocations for alternating contractions
* and expansions. However, typed allocation in the Boehm
* GC stores layout information in the last word of a memory
* block and we may accidentally overwrite this information,
* because GC_size() includes that extraneous word when
* returning the size of a memory block.
*
* This is technically a bug in GC_size(), but until and
* unless there is an upstream fix, we'll do it the safe
* way.
*/
if (new_size <= old_size &&
sizeof(BagHeader) + new_size >= alloc_size * 3 / 4) {
#else
if (new_size <= old_size) {
#endif /* DISABLE_GC */
/* change the size word */
header->size = new_size;
}
/* if the bag is enlarged */
else {
alloc_size = sizeof(BagHeader) + new_size;
if (new_size == 0)
alloc_size++;
#ifndef DISABLE_GC
header = AllocateBagMemory(TabMarkTypeBags[type], type, alloc_size);
#else
header = calloc(1, alloc_size);
#endif
header->type = type;
header->flags = flags;
header->size = new_size;
// copy data and update the masterpointer
src = PTR_BAG(bag);
memcpy(DATA(header), src, old_size < new_size ? old_size : new_size);
SET_PTR_BAG(bag, DATA(header));
}
/* return success */
return 1;
}
/*****************************************************************************
** The following functions are not required respectively supported, so empty
** implementations are provided
**
*/
void InitGlobalBag(Bag * addr, const Char * cookie)
{
}
void SwapMasterPoint(Bag bag1, Bag bag2)
{
Obj * ptr1 = PTR_BAG(bag1);
Obj * ptr2 = PTR_BAG(bag2);
SET_PTR_BAG(bag1, ptr2);
SET_PTR_BAG(bag2, ptr1);
}
