/**************************************************************************** ** ** 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 of the objects package.
*/
typedefstruct {
UInt PrintObjDepth;
Obj PrintObjThiss[MAXPRINTDEPTH]; Int PrintObjIndices[MAXPRINTDEPTH];
// This variable is used to allow a ViewObj method to call PrintObj on the // same object without triggering use of '~'. It contains one of the // values 0, 1 and 2 according to whether ... // 0: there is no enclosing call to PrintObj or ViewObj still open, or // 1: the innermost such is PrintObj, or // 2: the innermost such is ViewObj.
UInt LastPV;
/**************************************************************************** ** *V NameOfType[<type>] . . . . . . . . . . . . . . . . . . . . names of types ** ** 'NameOfType[<type>]' is the name of the type <type>.
*/ staticconstchar * NameOfType[NUM_TYPES];
/**************************************************************************** ** *F RegisterPackageTNUM( <name>, <typeObjFunc> ) ** ** Allocates a TNUM for use by a package. The parameters <name> and ** <typeObjFunc> are used to initialize the relevant entries in the ** InfoBags and TypeObjFuncs arrays. ** ** If allocation fails (e.g. because no more TNUMs are available), ** a negative value is returned.
*/ Int RegisterPackageTNUM( constchar *name, Obj (*typeObjFunc)(Obj obj) )
{ #ifdef HPCGAP
HashLock(0); #endif
if (lastFreePackageTNUM > LAST_PACKAGE_TNUM) return -1;
Int tnum = lastFreePackageTNUM++; #ifdef HPCGAP
HashUnlock(0); #endif
/**************************************************************************** ** *F TYPE_OBJ( <obj> ) . . . . . . . . . . . . . . . . . . . type of an object ** ** 'TYPE_OBJ' returns the type of the object <obj>. ** ** 'TYPE_OBJ' is defined in the declaration part of this package.
*/
Obj (*TypeObjFuncs[LAST_REAL_TNUM+1]) ( Obj obj );
static Obj TypeObjError(Obj obj)
{
ErrorQuit("Panic: basic object of type '%s' is unkind",
(Int)TNAM_OBJ(obj), 0); return 0;
}
/**************************************************************************** ** *F SET_TYPE_OBJ( <obj>, <type> ) . . . . . . . . . . . set type of an object ** ** 'SET_TYPE_OBJ' sets the type of the object <obj> to <type>; if <obj> ** is not a posobj/comobj/datobj, attempts to first convert it to one; if ** that fails, an error is raised.
*/ void SET_TYPE_OBJ(Obj obj, Obj type)
{ switch (TNUM_OBJ(obj)) { #ifdef HPCGAP case T_ALIST: case T_FIXALIST:
HashLock(obj);
ADDR_OBJ(obj)[1] = type;
CHANGED_BAG(obj);
RetypeBag(obj, T_APOSOBJ);
HashUnlock(obj);
MEMBAR_WRITE(); break; case T_APOSOBJ:
HashLock(obj);
ADDR_OBJ(obj)[1] = type;
CHANGED_BAG(obj);
HashUnlock(obj);
MEMBAR_WRITE(); break; case T_AREC: case T_ACOMOBJ:
ADDR_OBJ(obj)[0] = type;
CHANGED_BAG(obj);
RetypeBag(obj, T_ACOMOBJ);
MEMBAR_WRITE(); break; #endif case T_PREC: #ifdef HPCGAP
MEMBAR_WRITE(); #endif
RetypeBag(obj, T_COMOBJ);
SET_TYPE_COMOBJ(obj, type);
CHANGED_BAG(obj); break; case T_COMOBJ: #ifdef HPCGAP
ReadGuard(obj);
MEMBAR_WRITE(); #endif
SET_TYPE_COMOBJ(obj, type);
CHANGED_BAG(obj); break; case T_POSOBJ: #ifdef HPCGAP
ReadGuard(obj);
MEMBAR_WRITE(); #endif
SET_TYPE_POSOBJ(obj, type);
CHANGED_BAG(obj); break; case T_DATOBJ:
SetTypeDatObj(obj, type); break;
default: if (!IS_PLIST(obj)) {
ErrorMayQuit("cannot change type of a %s", (Int)TNAM_OBJ(obj), 0);
} // TODO: we should also reject immutable plists, but that risks // breaking existing code #ifdef HPCGAP
MEMBAR_WRITE(); #endif
RetypeBag(obj, T_POSOBJ);
SET_TYPE_POSOBJ(obj, type);
CHANGED_BAG(obj); break;
}
}
/**************************************************************************** ** *F IS_MUTABLE_OBJ( <obj> ) . . . . . . . . . . . . . . is an object mutable ** ** 'IS_MUTABLE_OBJ' returns 1 if the object <obj> is mutable (i.e., can ** change due to assignments), and 0 otherwise. ** ** 'IS_MUTABLE_OBJ' is defined in the declaration part of this package.
*/ BOOL (*IsMutableObjFuncs[LAST_REAL_TNUM + 1])(Obj obj);
static Obj IsMutableObjFilt;
staticBOOL IsMutableObjError(Obj obj)
{
ErrorQuit("Panic: tried to test mutability of unsupported type '%s'",
(Int)TNAM_OBJ(obj), 0); returnFALSE;
}
/**************************************************************************** ** *F IS_COPYABLE_OBJ(<obj>) . . . . . . . . . . . . . . is an object copyable ** ** 'IS_COPYABLE_OBJ' returns 1 if the object <obj> is copyable (i.e., can be ** copied into a mutable object), and 0 otherwise. ** ** 'IS_COPYABLE_OBJ' is defined in the declaration part of this package.
*/ BOOL (*IsCopyableObjFuncs[LAST_REAL_TNUM + 1])(Obj obj);
static Obj IsCopyableObjFilt;
staticBOOL IsCopyableObjError(Obj obj)
{
ErrorQuit("Panic: tried to test copyability of unsupported type '%s'",
(Int)TNAM_OBJ(obj), 0); returnFALSE;
}
// make the new object and copy the contents new = NewBag( MUTABLE_TNUM(TNUM_OBJ(obj)), SIZE_OBJ(obj) );
o = CONST_ADDR_OBJ(obj);
n = ADDR_OBJ( new );
memcpy(n, o, SIZE_OBJ(obj) );
// 'CHANGED_BAG(new);' not needed, <new> is newest object returnnew;
}
/**************************************************************************** ** *F PrepareCopy(<obj>,<copy>) . . . helper for use in CopyObjFuncs functions **
*/ void PrepareCopy(Obj obj, Obj copy)
{ // insert a forwarding pointer into <obj> which contains... // - the value overwritten by this forwarding pointer, // - a pointer to <copy>, // - the TNUM of <obj>. // Note that we cannot simply restore the overwritten value by copying // the corresponding value from <copy>, as they may actually differ // between original and copy (e.g. for objects, they point to the type; // if making an immutable copy of a mutable object, the types will // differ). // Likewise, the TNUM of the copy and the original can and will differ; // e.g. for a weak pointer list, the copy can be a plist.
Obj tmp = NEW_PLIST(T_PLIST, 3);
SET_LEN_PLIST(tmp, 3);
SET_ELM_PLIST(tmp, 1, CONST_ADDR_OBJ(obj)[0]);
SET_ELM_PLIST(tmp, 2, copy);
SET_ELM_PLIST(tmp, 3, INTOBJ_INT(TNUM_OBJ(obj)));
// update the TNUM to indicate the object is being copied
RetypeBag(obj, T_COPYING);
}
/**************************************************************************** ** *F COPY_OBJ(<obj>) . . . . . . . . . . . make a structural copy of an object ** ** 'COPY_OBJ' implements the first pass of 'CopyObj', i.e., it makes the ** structural copy of <obj> and marks <obj> as already copied.
*/
Obj COPY_OBJ(Obj obj, Int mut)
{
UInt tnum = TNUM_OBJ(obj);
Obj copy;
if (tnum == T_COPYING) { // get the plist reference by the forwarding pointer
Obj fpl = CONST_ADDR_OBJ(obj)[0];
/**************************************************************************** ** *F CLEAN_OBJ(<obj>) . . . . . . . . . . . . . clean up object after copying ** ** 'CLEAN_OBJ' implements the second pass of 'CopyObj', i.e., it removes the ** mark from <obj>.
*/ void CLEAN_OBJ(Obj obj)
{ if (TNUM_OBJ(obj) != T_COPYING) return;
// get the plist reference by the forwarding pointer
Obj fpl = CONST_ADDR_OBJ(obj)[0];
// remove the forwarding pointer
ADDR_OBJ(obj)[0] = ELM_PLIST(fpl, 1);
CHANGED_BAG(obj);
// immutable input is handled by COPY_OBJ
GAP_ASSERT(IS_MUTABLE_OBJ(obj));
// if the object is not copyable return if ( ! IS_COPYABLE_OBJ(obj) ) {
ErrorQuit("Panic: encountered mutable, non-copyable object", 0, 0);
}
// make a copy
copy = NewBag( TNUM_OBJ(obj), SIZE_OBJ(obj) );
memcpy(ADDR_OBJ(copy), CONST_ADDR_OBJ(obj), SIZE_OBJ(obj)); if ( !mut ) {
CALL_2ARGS( RESET_FILTER_OBJ, copy, IsMutableObjFilt );
}
// leave a forwarding pointer
PrepareCopy(obj, 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);
}
/**************************************************************************** ** *F MakeImmutable( <obj> . . . . . . . . . . make an object immutable inplace ** ** Mark an object and all subobjects immutable in-place. ** May cause confusion if there are shared subobjects **
*/
#ifdef HPCGAP // HPCGAP-HACK: // There is a considerable amount of library code that currently // relies on being able to modify immutable data objects; in order // to not break all of that, MakeImmutableDatObj() makes immutable // data objects public, not read-only if they are not internally // mutable. Note that this is potentially unsafe if these objects // are shared between threads and then modified by kernel code. // // By setting the environment variable GAP_READONLY_DATOBJS, one // can restore the old behavior in order to find and debug the // offending code. staticint ReadOnlyDatObjs = 0; #endif
// This function is used to keep track of which objects are already // being printed or viewed to trigger the use of ~ when needed. staticinlineBOOL IS_ON_PRINT_STACK(const ObjectsModuleState * os, Obj obj)
{ if (!(FIRST_RECORD_TNUM <= TNUM_OBJ(obj) &&
TNUM_OBJ(obj) <= LAST_LIST_TNUM)) returnFALSE; for (UInt i = 0; i < os->PrintObjDepth; i++) if (os->PrintObjThiss[i] == obj) returnTRUE; returnFALSE;
}
// First check if <obj> is actually the current object being viewed, since // ViewObj(<obj>) may result in a call to PrintObj(<obj>); in that case, // we should not put <obj> on the print stack if ((os->PrintObjDepth > 0) && (os->LastPV == 2) &&
(obj == os->PrintObjThiss[os->PrintObjDepth - 1])) {
os->LastPV = 1;
PRINT_OBJ(obj);
os->LastPV = 2;
}
// print the path if <obj> is on the stack elseif (IS_ON_PRINT_STACK(os, obj)) {
Pr("~", 0, 0); for (int i = 0; obj != os->PrintObjThiss[i]; i++) {
PRINT_PATH(os->PrintObjThiss[i], os->PrintObjIndices[i]);
}
}
// dispatch to the appropriate printing function elseif (os->PrintObjDepth < MAXPRINTDEPTH) {
Obj oldThis = os->PrintObjThiss[os->PrintObjDepth]; Int oldIndx = os->PrintObjIndices[os->PrintObjDepth];
// push obj on the stack
os->PrintObjThiss[os->PrintObjDepth] = obj;
os->PrintObjIndices[os->PrintObjDepth] = 0;
os->PrintObjDepth++;
// pop <obj> from the stack
os->PrintObjDepth--;
os->PrintObjThiss[os->PrintObjDepth] = oldThis;
os->PrintObjIndices[os->PrintObjDepth] = oldIndx;
} else {
Pr("\nprinting stopped, too many recursion levels!\n", 0, 0);
}
}
/**************************************************************************** ** *V PrintObjFuncs[<type>] . . . . . . . . printer for objects of type <type> ** ** 'PrintObjFuncs' is the dispatch table that contains for every type of ** objects a pointer to the printer for objects of this type. The printer ** is the function '<func>(<obj>)' that should be called to print the object ** <obj> of this type.
*/ void (* PrintObjFuncs [ LAST_REAL_TNUM +1 ])( Obj obj );
// print the path if <obj> is on the stack if (IS_ON_PRINT_STACK(os, obj)) {
Pr("~", 0, 0); for (int i = 0; obj != os->PrintObjThiss[i]; i++) {
PRINT_PATH(os->PrintObjThiss[i], os->PrintObjIndices[i]);
}
}
// dispatch to the appropriate viewing function elseif (os->PrintObjDepth < MAXPRINTDEPTH) {
Obj oldThis = os->PrintObjThiss[os->PrintObjDepth]; Int oldIndx = os->PrintObjIndices[os->PrintObjDepth];
// push obj on the stack
os->PrintObjThiss[os->PrintObjDepth] = obj;
os->PrintObjIndices[os->PrintObjDepth] = 0;
os->PrintObjDepth++;
/**************************************************************************** ** *F AssPosbj( <obj>, <rnam>, <val> ) *F UnbPosbj( <obj>, <rnam> ) *F ElmPosbj( <obj>, <rnam> ) *F IsbPosbj( <obj>, <rnam> )
*/ void AssPosObj(Obj obj, Int idx, Obj val)
{ if (TNUM_OBJ(obj) == T_POSOBJ) { #ifdef HPCGAP // Because BindOnce() functions can reallocate the list even if they // only have read-only access, we have to be careful when accessing // positional objects. Hence the explicit WriteGuard().
WriteGuard(obj); #endif if (SIZE_OBJ(obj) / sizeof(Obj) - 1 < idx) {
ResizeBag(obj, (idx + 1) * sizeof(Obj));
}
SET_ELM_PLIST(obj, idx, val);
CHANGED_BAG(obj);
} #ifdef HPCGAP elseif (TNUM_OBJ(obj) == T_APOSOBJ) {
AssListFuncs[T_FIXALIST](obj, idx, val);
} #endif else {
ASS_LIST(obj, idx, val);
}
}
void UnbPosObj(Obj obj, Int idx)
{ if (TNUM_OBJ(obj) == T_POSOBJ) { #ifdef HPCGAP // Because BindOnce() functions can reallocate the list even if they // only have read-only access, we have to be careful when accessing // positional objects. Hence the explicit WriteGuard().
WriteGuard(obj); #endif if (idx <= SIZE_OBJ(obj) / sizeof(Obj) - 1) {
SET_ELM_PLIST(obj, idx, 0);
}
} #ifdef HPCGAP elseif (TNUM_OBJ(obj) == T_APOSOBJ) {
UnbListFuncs[T_FIXALIST](obj, idx);
} #endif else {
UNB_LIST(obj, idx);
}
}
Obj ElmPosObj(Obj obj, Int idx)
{
Obj elm; if (TNUM_OBJ(obj) == T_POSOBJ) { #ifdef HPCGAP // Because BindOnce() functions can reallocate the list even if they // only have read-only access, we have to be careful when accessing // positional objects. const Bag * contents = CONST_PTR_BAG(obj);
MEMBAR_READ(); // essential memory barrier if (SIZE_BAG_CONTENTS(contents) / sizeof(Obj) - 1 < idx) {
ErrorMayQuit( "PosObj Element: ![%d] must have an assigned value",
(Int)idx, 0);
}
elm = contents[idx]; #else if (SIZE_OBJ(obj) / sizeof(Obj) - 1 < idx) {
ErrorMayQuit( "PosObj Element: ![%d] must have an assigned value",
(Int)idx, 0);
}
elm = ELM_PLIST(obj, idx); #endif if (elm == 0) {
ErrorMayQuit( "PosObj Element: ![%d] must have an assigned value",
(Int)idx, 0);
}
} #ifdef HPCGAP elseif (TNUM_OBJ(obj) == T_APOSOBJ) {
elm = ElmListFuncs[T_FIXALIST](obj, idx);
} #endif else {
elm = ELM_LIST(obj, idx);
} return elm;
}
BOOL IsbPosObj(Obj obj, Int idx)
{ BOOL isb; if (TNUM_OBJ(obj) == T_POSOBJ) { #ifdef HPCGAP // Because BindOnce() functions can reallocate the list even if they // only have read-only access, we have to be careful when accessing // positional objects. const Bag * contents = CONST_PTR_BAG(obj); if (idx > SIZE_BAG_CONTENTS(contents) / sizeof(Obj) - 1)
isb = FALSE; else
isb = contents[idx] != 0; #else
isb = (idx <= SIZE_OBJ(obj) / sizeof(Obj) - 1 &&
ELM_PLIST(obj, idx) != 0); #endif
} #ifdef HPCGAP elseif (TNUM_OBJ(obj) == T_APOSOBJ) {
isb = IsbListFuncs[T_FIXALIST](obj, idx);
} #endif else {
isb = ISB_LIST(obj, idx);
} return isb;
}
/**************************************************************************** ** *F TypeDatObj( <obj> ) . . . . . . . . . . function version of 'TYPE_DATOBJ'
*/ static Obj TypeDatObj(Obj obj)
{
Obj type = TYPE_DATOBJ( obj ); return type ? type : TYPE_KERNEL_OBJECT;
}
/**************************************************************************** ** *V SaveObjFuncs (<type>) . . . . . . . . . . . . . functions to save objects ** ** 'SaveObjFuncs' is the dispatch table that contains, for every type ** of objects, a pointer to the saving function for objects of that type ** These should not handle the file directly, but should work via the ** functions 'SaveSubObj', 'SaveUInt<n>' (<n> = 1,2,4 or 8), and others ** to be determined. Their role is to identify the C types of the various ** parts of the bag, and perhaps to leave out some information that does ** not need to be saved. By the time this function is called, the bag ** size and type have already been saved ** No saving function may allocate any bag
*/ #ifdef GAP_ENABLE_SAVELOAD void (*SaveObjFuncs[LAST_REAL_TNUM+1]) ( Obj obj );
void SaveObjError( Obj obj )
{
ErrorQuit("Panic: tried to save an object of unsupported type '%s'",
(Int)TNAM_OBJ(obj), 0);
} #endif
/**************************************************************************** ** *V LoadObjFuncs (<type>) . . . . . . . . . . . . . functions to load objects ** ** 'LoadObjFuncs' is the dispatch table that contains, for every type ** of objects, a pointer to the loading function for objects of that type ** These should not handle the file directly, but should work via the ** functions 'LoadObjRef', 'LoadUInt<n>' (<n> = 1,2,4 or 8), and others ** to be determined. Their role is to reinstall the information in the bag ** and reconstruct anything that was left out. By the time this function is ** called, the bag size and type have already been loaded and the bag argument ** contains the bag in question ** No loading function may allocate any bag
*/ #ifdef GAP_ENABLE_SAVELOAD void (*LoadObjFuncs[LAST_REAL_TNUM+1]) ( Obj obj );
void LoadObjError( Obj obj )
{
ErrorQuit("Panic: tried to load an object of unsupported type '%s'",
(Int)TNAM_OBJ(obj), 0);
} #endif
/**************************************************************************** ** *F SaveComObj( Obj comobj) **
*/ #ifdef GAP_ENABLE_SAVELOAD staticvoid SaveComObj(Obj comobj)
{
UInt len,i;
SaveSubObj(TYPE_COMOBJ( comobj ));
len = LEN_PREC(comobj);
SaveUInt(len); for (i = 1; i <= len; i++)
{
SaveUInt(GET_RNAM_PREC(comobj, i));
SaveSubObj(GET_ELM_PREC(comobj, i));
}
} #endif
/**************************************************************************** ** *F SavePosObj( Obj posobj) **
*/ #ifdef GAP_ENABLE_SAVELOAD staticvoid SavePosObj(Obj posobj)
{
UInt len,i;
SaveSubObj(TYPE_POSOBJ( posobj ));
len = (SIZE_OBJ(posobj)/sizeof(Obj) - 1); for (i = 1; i <= len; i++)
{
SaveSubObj(CONST_ADDR_OBJ(posobj)[i]);
}
} #endif
/**************************************************************************** ** *F SaveDatObj( Obj datobj) ** ** Here we lose endianness protection, because we don't know if this is really ** UInts, or if it might be smaller data
*/ #ifdef GAP_ENABLE_SAVELOAD staticvoid SaveDatObj(Obj datobj)
{
UInt len,i; const UInt * ptr;
SaveSubObj(TYPE_DATOBJ( datobj ));
len = ((SIZE_OBJ(datobj)+sizeof(UInt)-1)/sizeof(UInt) - 1);
ptr = (const UInt *)CONST_ADDR_OBJ(datobj) + 1; for (i = 1; i <= len; i++)
{
SaveUInt(*ptr++);
}
} #endif
/**************************************************************************** ** *F LoadComObj( Obj comobj) **
*/ #ifdef GAP_ENABLE_SAVELOAD staticvoid LoadComObj(Obj comobj)
{
UInt len,i;
SET_TYPE_COMOBJ(comobj, LoadSubObj());
len = LoadUInt();
SET_LEN_PREC(comobj,len); for (i = 1; i <= len; i++)
{
SET_RNAM_PREC(comobj, i, LoadUInt());
SET_ELM_PREC(comobj, i, LoadSubObj());
}
} #endif
/**************************************************************************** ** *F LoadPosObj( Obj posobj) **
*/ #ifdef GAP_ENABLE_SAVELOAD staticvoid LoadPosObj(Obj posobj)
{
UInt len,i;
SET_TYPE_POSOBJ(posobj, LoadSubObj());
len = (SIZE_OBJ(posobj)/sizeof(Obj) - 1); for (i = 1; i <= len; i++)
{
ADDR_OBJ(posobj)[i] = LoadSubObj();
}
} #endif
/**************************************************************************** ** *F LoadDatObj( Obj datobj) ** ** Here we lose endianness protection, because we don't know if this is really ** UInts, or if it might be smaller data
*/ #ifdef GAP_ENABLE_SAVELOAD staticvoid LoadDatObj(Obj datobj)
{
UInt len,i;
UInt *ptr;
SET_TYPE_DATOBJ(datobj, LoadSubObj());
len = ((SIZE_OBJ(datobj)+sizeof(UInt)-1)/sizeof(UInt) - 1);
ptr = (UInt *)ADDR_OBJ(datobj)+1; for (i = 1; i <= len; i++)
{
*ptr ++ = LoadUInt();
}
} #endif
/**************************************************************************** ** *F * * * * * * * * GAP functions for "to be defined" objects * * * * * * * *
*/
/**************************************************************************** ** *F FuncCLONE_OBJ( <self>, <dst>, <src> ) . . . . . . . clone <src> to <dst> ** ** `CLONE_OBJ' clones the source <src> into <dst>. It is not allowed to ** clone small integers or finite field elements. ** ** If <src> is a constant, than a "shallow" copy, that is to say, a bit-copy ** of the bag of <src> is created. If <src> is mutable than a "structural ** copy is created, which is then in turn "shallow" cloned into <dst>. ** ** WARNING: at the moment the functions breaks on cloning `[1,~]'. This can ** be fixed if necessary.
*/ static Obj IsToBeDefinedObj;
// check <src> if ( IS_INTOBJ(src) ) {
ErrorMayQuit("small integers cannot be cloned", 0, 0);
} if ( IS_FFE(src) ) {
ErrorMayQuit("finite field elements cannot be cloned", 0, 0);
} if ( TNUM_OBJ(src) == T_BOOL ) {
ErrorMayQuit("booleans cannot be cloned", 0, 0);
}
#ifdef HPCGAP switch (TNUM_OBJ(src)) { case T_AREC: case T_ACOMOBJ: case T_TLREC:
ErrorMayQuit("cannot clone %ss", (Int)TNAM_OBJ(src), 0);
} if (!REGION(dst)) {
ErrorMayQuit("CLONE_OBJ() cannot overwrite public objects", 0, 0);
} if (REGION(src) != REGION(dst) && REGION(src)) {
ErrorMayQuit("objects can only be cloned to replace objects within" "the same region or if the object is public",
0, 0);
} #endif
// if object is mutable, produce a structural copy if ( IS_MUTABLE_OBJ(src) ) {
src = CopyObj( src, 1 );
}
// now shallow clone the object #ifdef HPCGAP
Obj tmp = NewBag(TNUM_OBJ(src), SIZE_OBJ(src));
pdst = ADDR_OBJ(tmp); #else
ResizeBag( dst, SIZE_OBJ(src) );
RetypeBag( dst, TNUM_OBJ(src) );
pdst = ADDR_OBJ(dst); #endif
psrc = CONST_ADDR_OBJ(src);
memcpy(pdst, psrc, SIZE_OBJ(src));
CHANGED_BAG(dst); #ifdef HPCGAP
SET_REGION(dst, REGION(src));
MEMBAR_WRITE(); // The following is a no-op unless the region is public
SET_PTR_BAG(dst, PTR_BAG(tmp)); #endif
return 0;
}
/**************************************************************************** ** *F FuncSWITCH_OBJ( <self>, <obj1>, <obj2> ) . . . switch <obj1> and <obj2> ** ** `SWITCH_OBJ' exchanges the objects referenced by its two arguments. It ** is not allowed to switch clone small integers or finite field elements. ** ** This is inspired by the Smalltalk 'become:' operation.
*/
static Obj FuncSWITCH_OBJ(Obj self, Obj obj1, Obj obj2)
{ if ( IS_INTOBJ(obj1) || IS_INTOBJ(obj2) ) {
ErrorMayQuit("small integer objects cannot be switched", 0, 0);
} if ( IS_FFE(obj1) || IS_FFE(obj2) ) {
ErrorMayQuit("finite field elements cannot be switched", 0, 0);
} #ifdef HPCGAP
Region * ds1 = REGION(obj1);
Region * ds2 = REGION(obj2); if (!ds1 || ds1->owner != GetTLS())
ErrorQuit("SWITCH_OBJ: Cannot write to first object's region.", 0, 0); if (!ds2 || ds2->owner != GetTLS())
ErrorQuit("SWITCH_OBJ: Cannot write to second object's region.", 0, 0);
SET_REGION(obj2, ds1);
SET_REGION(obj1, ds2); #endif
SwapMasterPoint(obj1, obj2); return 0;
}
/**************************************************************************** ** *F FuncFORCE_SWITCH_OBJ( <self>, <obj1>, <obj2> ) . switch <obj1> and <obj2> ** ** `FORCE_SWITCH_OBJ' exchanges the objects referenced by its two arguments. ** It is not allowed to switch clone small integers or finite field ** elements. ** ** In GAP, FORCE_SWITCH_OBJ does the same thing as SWITCH_OBJ. In HPC_GAP ** it allows public objects to be exchanged.
*/
static Obj FuncFORCE_SWITCH_OBJ(Obj self, Obj obj1, Obj obj2)
{ if ( IS_INTOBJ(obj1) || IS_INTOBJ(obj2) ) {
ErrorMayQuit("small integer objects cannot be switched", 0, 0);
} if ( IS_FFE(obj1) || IS_FFE(obj2) ) {
ErrorMayQuit("finite field elements cannot be switched", 0, 0);
} #ifdef HPCGAP
Region * ds1 = REGION(obj1);
Region * ds2 = REGION(obj2); if (ds1 && ds1->owner != GetTLS())
ErrorQuit("FORCE_SWITCH_OBJ: Cannot write to first object's region.", 0, 0); if (ds2 && ds2->owner != GetTLS())
ErrorQuit("FORCE_SWITCH_OBJ: Cannot write to second object's region.", 0, 0);
SET_REGION(obj2, ds1);
SET_REGION(obj1, ds2); #endif
SwapMasterPoint(obj1, obj2); return 0;
}
// make and install the 'IS_MUTABLE_OBJ' filter for ( t = FIRST_REAL_TNUM; t <= LAST_REAL_TNUM; t++ ) {
assert(IsMutableObjFuncs[ t ] == 0);
IsMutableObjFuncs[ t ] = IsMutableObjError;
} for ( t = FIRST_CONSTANT_TNUM; t <= LAST_CONSTANT_TNUM; t++ )
IsMutableObjFuncs[ t ] = AlwaysNo; for ( t = FIRST_EXTERNAL_TNUM; t <= LAST_EXTERNAL_TNUM; t++ )
IsMutableObjFuncs[ t ] = IsMutableObjObject;
// make and install the 'IS_COPYABLE_OBJ' filter for ( t = FIRST_REAL_TNUM; t <= LAST_REAL_TNUM; t++ ) {
assert(IsCopyableObjFuncs[ t ] == 0);
IsCopyableObjFuncs[ t ] = IsCopyableObjError;
} for ( t = FIRST_CONSTANT_TNUM; t <= LAST_CONSTANT_TNUM; t++ )
IsCopyableObjFuncs[ t ] = AlwaysNo; for ( t = FIRST_EXTERNAL_TNUM; t <= LAST_EXTERNAL_TNUM; t++ )
IsCopyableObjFuncs[ t ] = IsCopyableObjObject;
// make and install the 'SHALLOW_COPY_OBJ' operation for ( t = FIRST_REAL_TNUM; t <= LAST_REAL_TNUM; t++ ) {
assert(ShallowCopyObjFuncs[ t ] == 0);
ShallowCopyObjFuncs[ t ] = ShallowCopyObjError;
} for ( t = FIRST_CONSTANT_TNUM; t <= LAST_CONSTANT_TNUM; t++ )
ShallowCopyObjFuncs[ t ] = ShallowCopyObjConstant; for ( t = FIRST_RECORD_TNUM; t <= LAST_RECORD_TNUM; t++ )
ShallowCopyObjFuncs[ t ] = ShallowCopyObjDefault; for ( t = FIRST_LIST_TNUM; t <= LAST_LIST_TNUM; t++ )
ShallowCopyObjFuncs[ t ] = ShallowCopyObjDefault; for ( t = FIRST_EXTERNAL_TNUM; t <= LAST_EXTERNAL_TNUM; t++ )
ShallowCopyObjFuncs[ t ] = ShallowCopyObjObject;
#ifdef USE_THREADSAFE_COPYING
SetTraversalMethod(T_POSOBJ, TRAVERSE_ALL_BUT_FIRST, 0, 0);
SetTraversalMethod(T_COMOBJ, TRAVERSE_BY_FUNCTION, TraversePRecord, CopyPRecord);
SetTraversalMethod(T_DATOBJ, TRAVERSE_NONE, 0, 0); #else // make and install the 'COPY_OBJ' function for ( t = FIRST_REAL_TNUM; t <= LAST_REAL_TNUM; t++ ) {
assert(CopyObjFuncs [ t ] == 0);
CopyObjFuncs [ t ] = CopyObjError;
assert(CleanObjFuncs[ t ] == 0);
CleanObjFuncs[ t ] = CleanObjError;
} for ( t = FIRST_CONSTANT_TNUM; t <= LAST_CONSTANT_TNUM; t++ ) {
CopyObjFuncs [ t ] = CopyObjConstant;
CleanObjFuncs[ t ] = 0;
}
CopyObjFuncs[ T_POSOBJ ] = CopyObjPosObj;
CleanObjFuncs[ T_POSOBJ ] = CleanObjPosObj;
CopyObjFuncs[ T_COMOBJ ] = CopyObjComObj;
CleanObjFuncs[ T_COMOBJ ] = CleanObjComObj;
CopyObjFuncs[ T_DATOBJ ] = CopyObjDatObj;
CleanObjFuncs[ T_DATOBJ ] = CleanObjDatObj; #endif
// make and install the 'PRINT_OBJ' operation for ( t = FIRST_REAL_TNUM; t <= LAST_REAL_TNUM; t++ ) {
assert(PrintObjFuncs[ t ] == 0);
PrintObjFuncs[ t ] = PrintObjObject;
}
#ifdef GAP_ENABLE_SAVELOAD // enter 'SaveObjError' and 'LoadObjError' for all types initially for ( t = FIRST_REAL_TNUM; t <= LAST_REAL_TNUM; t++ ) {
assert(SaveObjFuncs[ t ] == 0);
SaveObjFuncs[ t ] = SaveObjError;
assert(LoadObjFuncs[ t ] == 0);
LoadObjFuncs[ t ] = LoadObjError;
}
¤ 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.0.22Bemerkung:
(vorverarbeitet)
¤
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.