/**************************************************************************** ** ** This file is part of GAP, a system for computational discrete algebra. ** ** Copyright of GAP belongs to its developers, whose names are too numerous ** to list here. Please refer to the COPYRIGHT file for details. ** ** SPDX-License-Identifier: GPL-2.0-or-later ** ** This file contains the functions for plain records. ** ** A plain record with <n> components is stored as a bag with 2*<n>+2 ** entries. The odd entries are the record names of the components and the ** even entries are the corresponding values. ** The first pointer in the bag is reserved for the pointer to the type ** object if the record becomes a component object. The second slot ** in the bag is the number <n> of components as a C int. ** Normally, the rnams are sorted such that we can do a binary lookup. ** However, we allow for lazy sorting. This is done as follows: New ** components are always appended (record bags grow by a factor of 5/4 ** if needed as plists do), already sorted rnams are stored by storing ** their negative value to indicate sortedness. The new entries will have ** positive rnams and can thus be distinguished. Every read access will ** clean up the mess by sorting the new part and then merging the two ** sorted areas. After that, all rnams are negative indicating sortedness. **
*/
/**************************************************************************** ** *F * * * * * * * * * standard functions for plain records * * * * * * * * * *
*/
/**************************************************************************** ** *F TypePRec( <rec> ) . . . . . . . . . . . . . . . . type of a plain record ** ** 'TypePRec' returns the type of the plain record <rec>. ** ** 'TypePRec' is the function in 'TypeObjFuncs' for plain records.
*/ static Obj TYPE_PREC_MUTABLE; static Obj TYPE_PREC_IMMUTABLE;
void TraversePRecord(TraversalState * traversal, Obj obj)
{
UInt i, len = LEN_PREC(obj); for (i = 1; i <= len; i++)
QueueForTraversal(traversal, (Obj)GET_ELM_PREC(obj, i));
}
void CopyPRecord(TraversalState * traversal, Obj copy, Obj original)
{
UInt i, len = LEN_PREC(original); for (i = 1; i <= len; i++)
SET_ELM_PREC(copy, i, ReplaceByCopy(traversal, GET_ELM_PREC(original, i)));
}
#endif// WARD_ENABLED #else
/**************************************************************************** ** *F CopyPRec( <rec> ) . . . . . . . . . . . . . . . . . . copy a plain record *F CleanPRec( <rec> ) . . . . . . . . . . . . . . . clean up a plain record ** ** 'CopyPRec' returns a structural (deep) copy of the record <rec>, i.e., a ** recursive copy that preserves the structure. ** ** If <rec> has not yet been copied, it makes a copy, leaves a forward ** pointer to the copy in the first entry of the record, where the first ** record name usually resides, and copies all the entries. If the record ** has already been copied, it returns the value of the forwarding pointer. ** ** 'CopyPRec' is the function in 'CopyObjFuncs' for records. ** ** 'CleanPRec' removes the mark and the forwarding pointer from the record ** <rec>. ** ** 'CleanPRec' is the function in 'CleanObjFuncs' for records.
*/ static Obj CopyPRec(Obj rec, Int mut)
{
Obj copy; // copy, result
Obj tmp; // temporary variable
// immutable input is handled by COPY_OBJ
GAP_ASSERT(IS_MUTABLE_OBJ(rec));
// make a copy
copy = NewBag(T_PREC, SIZE_OBJ(rec)); if (!mut)
MakeImmutableNoRecurse(copy);
memcpy(ADDR_OBJ(copy), CONST_ADDR_OBJ(rec), SIZE_OBJ(rec));
// leave a forwarding pointer
PrepareCopy(rec, copy);
// copy the subvalues; since we used memcpy above, we don't need to worry // about copying the length or RNAMs; and by working solely inside the // copy, we avoid triggering tnum assertions in GET_ELM_PREC and // SET_ELM_PREC const UInt len = LEN_PREC(copy); for (UInt i = 1; i <= len; i++) {
tmp = COPY_OBJ(GET_ELM_PREC(copy, i), mut);
SET_ELM_PREC(copy, i, tmp);
CHANGED_BAG(copy);
}
staticvoid MakeImmutablePRec(Obj rec)
{ // change the tnum first, to avoid infinite recursion for objects that // contain themselves
MakeImmutableNoRecurse(rec);
// FIXME HPC-GAP: there is a potential race here: <rec> becomes public // the moment we change its type, but it's not ready for public access // until the following code completed.
UInt len = LEN_PREC(rec); for (UInt i = 1; i <= len; i++)
MakeImmutable(GET_ELM_PREC(rec, i));
// Sort the record at this point. This can never hurt, unless the record // will never be accessed again anyway. But for HPC-GAP it is essential so // that immutable records are actually binary unchanging.
SortPRecRNam(rec);
}
/**************************************************************************** * FindPRec( <rec>, <rnam>, <pos>, <cleanup> ) * . . . . . . . . . . . . . . . . . find a component name by binary search * * Searches rnam in rec, sets pos to the position where it is found (return * value 1) or where it should be inserted if it is not found (return val 0). * If cleanup is nonzero, a dirty record is automatically cleaned up. * If cleanup is 0, this does not happen.
*/
UInt PositionPRec(Obj rec, UInt rnam, int cleanup)
{ // This only assumes that the rnam values in the record are sorted!
UInt low = 1;
UInt high = LEN_PREC(rec); if (high > 0 && GET_RNAM_PREC(rec, high) > 0) { // DIRTY! Not everything sorted! #ifdef HPCGAP // FIXME: Need to sort records before making them // readonly or sharing them. This can be done in // the traversal routines (in principle). if (cleanup && CheckExclusiveWriteAccess(rec)) { #else if (cleanup) { #endif
SortPRecRNam(rec);
} else { // We are not allowed to cleanup, so we live with it, we // first try to find rnam in the mess at the end, then // fall back to binary search:
UInt i = high; while (i >= 1) { Int rnam2 = GET_RNAM_PREC(rec, i); if (rnam == rnam2) {
GAP_ASSERT(i != 0); return i;
} if (rnam2 < 0) { // reached the sorted area!
high = i; // will be incremented by 1 break;
}
i--;
} if (i == 0) return 0; // Here, high is the number of the sorted entries.
}
}
high++; Int rnam2 = 0; // Negate rnam, as the sorted part of the record is stored negated
rnam = -rnam; while (low < high) {
UInt i = (low + high) / 2; // we always have low <= i < high
rnam2 = GET_RNAM_PREC(rec, i); if (rnam2 > rnam) {
low = i + 1;
} elseif (rnam2 < rnam) {
high = i;
} else { return i;
}
}
return 0;
}
/**************************************************************************** ** *F IsbPRec( <rec>, <rnam> ) . . . . test for an element from a plain record ** ** 'IsbPRec' returns 1 if the record <rec> has a component with the record ** name <rnam>, and 0 otherwise.
*/ BOOL IsbPRec(Obj rec, UInt rnam)
{ return PositionPRec(rec, rnam, 1) != 0;
}
/**************************************************************************** ** *F ElmPRec( <rec>, <rnam> ) . . . . . select an element from a plain record ** ** 'ElmPRec' returns the element, i.e., the value of the component, with the ** record name <rnam> in the plain record <rec>. An error is signalled if ** <rec> has no component with record name <rnam>.
*/
Obj ElmPRec (
Obj rec,
UInt rnam )
{
UInt i = PositionPRec(rec, rnam, 1); if (i) return GET_ELM_PREC( rec, i );
ErrorMayQuit("Record Element: '.%g' must have an assigned value",
(Int)NAME_RNAM(rnam), 0);
}
/**************************************************************************** ** *F UnbPRec( <rec>, <rnam> ) . unbind a record component from a plain record ** ** 'UnbPRec' removes the record component with the record name <rnam> from ** the record <rec>.
*/ void UnbPRec (
Obj rec,
UInt rnam )
{
UInt len; // length of <rec>
// Accept T_PREC and T_COMOBJ, reject T_PREC+IMMUTABLE if (TNUM_OBJ(rec) == T_PREC+IMMUTABLE) {
ErrorMayQuit("Record Unbind: must be a mutable record", 0, 0);
}
UInt i = PositionPRec(rec, rnam, 1);
if (i) { // otherwise move everything forward
len = LEN_PREC( rec ); for ( ; i < len; i++ ) {
SET_RNAM_PREC( rec, i, GET_RNAM_PREC( rec, i+1 ) );
SET_ELM_PREC( rec, i, GET_ELM_PREC( rec, i+1 ) );
}
SET_RNAM_PREC( rec, len, 0 );
SET_ELM_PREC( rec, len, 0 );
// resize the record
SET_LEN_PREC(rec,LEN_PREC(rec)-1);
} else // do nothing if no such component exists return;
}
/**************************************************************************** ** *F AssPRec( <rec>, <rnam>, <val> ) . . . . . . . . assign to a plain record ** ** 'AssPRec' assigns the value <val> to the record component with the record ** name <rnam> in the plain record <rec>.
*/ void AssPRec (
Obj rec,
UInt rnam,
Obj val )
{
UInt len; // length of <rec>
// Accept T_PREC and T_COMOBJ, reject T_PREC+IMMUTABLE if (TNUM_OBJ(rec) == T_PREC+IMMUTABLE) {
ErrorMayQuit("Record Assignment: must be a mutable record", 0,
0);
}
// get the length of the record
len = LEN_PREC( rec );
if (len % 1000 == 0) { // A hack to occasionally do some cleanup!
SortPRecRNam(rec);
}
UInt i = PositionPRec(rec, rnam, 0);
if (!i) { // No cleanup allowed here to allow for multiple assignments! // extend the record if no such component exists
len++;
GrowPRec(rec, len);
i = len;
SET_RNAM_PREC( rec, i, rnam );
SET_LEN_PREC(rec,len);
} // assign the value to the component
SET_ELM_PREC( rec, i, val );
CHANGED_BAG( rec );
}
/**************************************************************************** ** *F PrintPRec( <rec> ) . . . . . . . . . . . . . . . . . . . print a record ** ** 'PrintRec' prints the plain record <rec>.
*/ staticvoid PrintPRec(Obj rec)
{
DoOperation1Args( PrintObjOper, rec );
}
/**************************************************************************** ** *F SortPRecRNam(<rec>) . . . . . . . . . . . . sort the Rnams of the record ** ** This is needed after the components of a record have been assigned ** in not necessarily sorted order in the kernel. It is automatically ** called on the first read access if necessary. See the top of "precord.c" ** for a comment on lazy sorting.
*/ staticint PrecComparer(constvoid *a, constvoid *b)
{ const UInt *aa = (const UInt *) a; const UInt *bb = (const UInt *) b; if (*aa < *bb) return -1; elseif (*aa == *bb) return 0; elsereturn 1;
}
void SortPRecRNam(Obj rec)
{
UInt len = LEN_PREC(rec);
UInt i,j,k,save; int issorted = 1;
Obj space;
// Nothing has to be done if it is already sorted: if (len == 0 || GET_RNAM_PREC(rec, len) < 0) return;
// First find the "unsorted part" and check whether it is sorted! for (i = len - 1; i >= 1 && GET_RNAM_PREC(rec, i) > 0; i--) { if (issorted && GET_RNAM_PREC(rec,i) > GET_RNAM_PREC(rec,i+1)) {
issorted = 0;
}
}
i++; // Now i points to the last positive (and thus still unsorted) // component and issorted is 1 iff positions i to len are sorted! if (!issorted && len - i + 1 > 1) {
qsort( ADDR_OBJ(rec)+2*i, len-i+1, 2*sizeof(Obj), &PrecComparer );
} // Now i points to the first positive component and the rest is // sorted.
save = i; if (save == 1 ||
-GET_RNAM_PREC(rec, save - 1) < GET_RNAM_PREC(rec, save)) { // Otherwise, nothing has to be done since it is already // sorted, we only have to negate the RNams! for (j = save;j <= len;j++)
SET_RNAM_PREC(rec, j, -GET_RNAM_PREC(rec, j)); return;
} // Next we perform a merge sort on the two presorted areas. // For optimal performance, we need some space to mess around:
space = NEW_PREC(len);
j = 1;
k = 1; while (j < save && i <= len) { if (-GET_RNAM_PREC(rec, j) < GET_RNAM_PREC(rec, i)) {
SET_RNAM_PREC(space,k,GET_RNAM_PREC(rec,j));
SET_ELM_PREC(space,k,GET_ELM_PREC(rec,j));
j++; k++;
} else {
SET_RNAM_PREC(space, k, -GET_RNAM_PREC(rec, i));
SET_ELM_PREC(space,k,GET_ELM_PREC(rec,i));
i++; k++;
}
} // Copy the rest of the part still missing: while (j < save) {
SET_RNAM_PREC(space, k, GET_RNAM_PREC(rec, j));
SET_ELM_PREC(space, k, GET_ELM_PREC(rec, j));
j++;
k++;
} while (i <= len) {
SET_RNAM_PREC(space, k, -GET_RNAM_PREC(rec, i));
SET_ELM_PREC(space, k, GET_ELM_PREC(rec, i));
i++;
k++;
} // Finally, copy everything back to where it came from:
memcpy(ADDR_OBJ(rec) + 2, CONST_ADDR_OBJ(space) + 2, sizeof(Obj) * 2 * len);
}
/**************************************************************************** ** *F FuncREC_NAMES( <self>, <rec> ) . . . . . . . . record names of a record ** ** 'FuncREC_NAMES' implements a method for the operations 'RecNames'. ** ** 'RecNames( <rec> )' ** ** 'RecNames' returns a list containing the names of the components of the ** record <rec> as strings.
*/ static Obj InnerRecNames(Obj rec)
{
Obj list; // list of record names, result
UInt rnam; // one name of record
Obj string; // one name as string
UInt i;
Obj name;
SortPRecRNam(rec); // Make sure rnams are sorted and thus negative
// allocate the list
list = NEW_PLIST( T_PLIST, LEN_PREC(rec) );
SET_LEN_PLIST( list, LEN_PREC(rec) );
// loop over the components for ( i = 1; i <= LEN_PREC(rec); i++ ) {
rnam = -GET_RNAM_PREC(rec, i); // could have been moved by garbage collection
name = NAME_RNAM( rnam );
string = CopyToStringRep( name );
SET_ELM_PLIST( list, i, string );
CHANGED_BAG( list );
}
// return the list return list;
}
static Obj FuncREC_NAMES(Obj self, Obj rec)
{ if (IS_PREC(rec)) { return InnerRecNames(rec);
} #ifdef HPCGAP if (TNUM_OBJ(rec) == T_AREC) { return InnerRecNames(FromAtomicRecord(rec));
} #endif
RequireArgument(SELF_NAME, rec, "must be a record"); return Fail;
}
/**************************************************************************** ** *F FuncREC_NAMES_COMOBJ( <self>, <rec> ) . . . record names of a record object
*/ // same as FuncREC_NAMES except for different argument check static Obj FuncREC_NAMES_COMOBJ(Obj self, Obj rec)
{ switch (TNUM_OBJ(rec)) { case T_COMOBJ: return InnerRecNames(rec); #ifdef HPCGAP case T_ACOMOBJ: return InnerRecNames(FromAtomicRecord(rec)); #endif
}
RequireArgument(SELF_NAME, rec, "must be a component object"); return Fail;
}
/**************************************************************************** ** *F EqPRec( <self>, <left>, <right> ) . . . . . . . comparison of two records ** ** 'EqPRec' returns '1' if the two operands <left> and <right> are equal ** and '0' otherwise. At least one operand must be a plain record.
*/ staticInt EqPRec(Obj left, Obj right)
{
UInt i; // loop variable
// quick first checks
GAP_ASSERT(IS_PREC(left));
GAP_ASSERT(IS_PREC(right)); if ( LEN_PREC(left) != LEN_PREC(right) ) return 0;
// ensure records are sorted by their RNam
SortPRecRNam(left);
SortPRecRNam(right);
CheckRecursionBefore();
// compare componentwise for ( i = 1; i <= LEN_PREC(right); i++ ) {
// compare the names if ( GET_RNAM_PREC(left,i) != GET_RNAM_PREC(right,i) ) {
DecRecursionDepth(); return 0;
}
// compare the values if ( ! EQ(GET_ELM_PREC(left,i),GET_ELM_PREC(right,i)) ) {
DecRecursionDepth(); return 0;
}
}
// the records are equal
DecRecursionDepth(); return 1;
}
/**************************************************************************** ** *F LtPRec( <self>, <left>, <right> ) . . . . . . . comparison of two records ** ** 'LtPRec' returns '1' if the operand <left> is less than the operand ** <right>, and '0' otherwise. At least one operand must be a plain ** record.
*/ staticInt LtPRec(Obj left, Obj right)
{
UInt i; // loop variable Int res; // result of comparison
// quick first checks
GAP_ASSERT(IS_PREC(left));
GAP_ASSERT(IS_PREC(right));
// ensure records are sorted by their RNam
SortPRecRNam(left);
SortPRecRNam(right);
CheckRecursionBefore();
res = 0;
// compare componentwise for ( i = 1; i <= LEN_PREC(right); i++ ) {
// if the left is a proper prefix of the right one if ( LEN_PREC(left) < i ) {
res = 1; break;
}
// compare the names // // The sense of this comparison is determined by the rule that // unbound entries compare less than bound ones if ( GET_RNAM_PREC(left,i) != GET_RNAM_PREC(right,i) ) {
res = !LT(NAME_RNAM(-GET_RNAM_PREC(left, i)),
NAME_RNAM(-GET_RNAM_PREC(right, i))); break;
}
// compare the values if ( ! EQ(GET_ELM_PREC(left,i),GET_ELM_PREC(right,i)) ) {
res = LT( GET_ELM_PREC(left,i), GET_ELM_PREC(right,i) ); break;
}
}
// the records are equal or the right is a prefix of the left
DecRecursionDepth(); return res;
}
/**************************************************************************** ** *F SavePRec( <prec> ) **
*/ #ifdef GAP_ENABLE_SAVELOAD staticvoid SavePRec(Obj prec)
{
UInt len,i;
len = LEN_PREC(prec);
SaveUInt(len); for (i = 1; i <= len; i++)
{
SaveUInt(GET_RNAM_PREC(prec, i));
SaveSubObj(GET_ELM_PREC(prec, i));
}
} #endif
/**************************************************************************** ** *F LoadPRec( <prec> ) **
*/ #ifdef GAP_ENABLE_SAVELOAD staticvoid LoadPRec(Obj prec)
{
UInt len,i;
len = LoadUInt();
SET_LEN_PREC(prec,len); for (i = 1; i <= len; i++)
{
SET_RNAM_PREC(prec, i, LoadUInt());
SET_ELM_PREC(prec, i, LoadSubObj());
}
} #endif
/**************************************************************************** ** *F MarkPRecSubBags( <bag> ) . . . . marking function for precs and com. objs ** ** 'MarkPRecSubBags' is the marking function for bags of type 'T_PREC' or ** 'T_COMOBJ'.
*/ void MarkPRecSubBags(Obj bag, void * ref)
{ const Bag * data = CONST_PTR_BAG(bag); const UInt count = SIZE_BAG(bag) / sizeof(Bag);
// data[0] is unused for regular precords, but it is used during copying // to store a pointer to the copy; moreover, this mark function is also // used for component objects, which store their type in slot 0
MarkBag(data[0], ref);
for (UInt i = 3; i < count; i += 2) {
MarkBag(data[i], ref);
}
}
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
