UInt IsVecFFE(Obj vec)
{
UInt tn;
tn = TNUM_OBJ(vec);
if (tn >= T_PLIST_FFE && tn <= T_PLIST_FFE + IMMUTABLE)
return 1;
if (!IS_PLIST(vec))
return 0;
TYPE_OBJ(vec); /* force a full inspection of the list */
tn = TNUM_OBJ(vec);
return tn >= T_PLIST_FFE && tn <= T_PLIST_FFE + IMMUTABLE;
}
static void AddObjSetNew(Obj set, Obj obj)
{
UInt size = CONST_ADDR_WORD(set)[OBJSET_SIZE];
UInt hash = ObjHash(set, obj);
GAP_ASSERT(TNUM_OBJ(set) == T_OBJSET);
GAP_ASSERT(hash < size);
for (;;) {
Obj current;
current = CONST_ADDR_OBJ(set)[OBJSET_HDRSIZE+hash];
if (!current) {
ADDR_OBJ(set)[OBJSET_HDRSIZE+hash] = obj;
ADDR_WORD(set)[OBJSET_USED]++;
CHANGED_BAG(set);
return;
}
if (current == Undefined) {
ADDR_OBJ(set)[OBJSET_HDRSIZE+hash] = obj;
ADDR_WORD(set)[OBJSET_USED]++;
GAP_ASSERT(ADDR_WORD(set)[OBJSET_DIRTY] >= 1);
ADDR_WORD(set)[OBJSET_DIRTY]--;
CHANGED_BAG(set);
return;
}
hash++;
if (hash >= size)
hash = 0;
}
}
Obj ZeroVecFFE( Obj vec )
{
UInt i, len;
Obj res;
Obj z;
assert(TNUM_OBJ(vec) >= T_PLIST_FFE && \
TNUM_OBJ(vec) <= T_PLIST_FFE + IMMUTABLE);
len = LEN_PLIST(vec);
assert(len);
res = NEW_PLIST(TNUM_OBJ(vec), len);
SET_LEN_PLIST(res, len);
z = ZERO(ELM_PLIST(vec, 1));
for (i = 1; i <= len; i++)
SET_ELM_PLIST(res, i, z);
return res;
}
Int GAP_ValueOfChar(Obj obj)
{
if (TNUM_OBJ(obj) != T_CHAR) {
return -1;
}
return (Int)CHAR_VALUE(obj);
}
void SerializeObj(Obj obj) {
if (!obj) {
/* Handle unbound list elements correctly */
SerializeUnbound();
return;
}
SerializationFuncByTNum[TNUM_OBJ(obj)](obj);
}
void SerializeObj(Obj obj)
{
if (!obj) {
/* Handle unbound list elements correctly */
WriteTNum(T_BACKREF);
WriteImmediateObj(INTOBJ_INT(0));
return;
}
SerializationFuncByTNum[TNUM_OBJ(obj)](obj);
}
Obj FuncMACFLOAT_STRING( Obj self, Obj s )
{
while (!IsStringConv(s))
{
s = ErrorReturnObj("MACFLOAT_STRING: object to be converted must be a string not a %s",
(Int)(InfoBags[TNUM_OBJ(s)].name),0,"You can return a string to continue" );
}
char * endptr;
UChar *sp = CHARS_STRING(s);
Obj res= NEW_MACFLOAT((Double) STRTOD((char *)sp,&endptr));
if ((UChar *)endptr != sp + GET_LEN_STRING(s))
return Fail;
return res;
}
Obj GAP_CallFuncArray(Obj func, UInt narg, Obj args[])
{
Obj result;
Obj list;
if (TNUM_OBJ(func) == T_FUNCTION) {
// call the function
switch (narg) {
case 0:
result = CALL_0ARGS(func);
break;
case 1:
result = CALL_1ARGS(func, args[0]);
break;
case 2:
result = CALL_2ARGS(func, args[0], args[1]);
break;
case 3:
result = CALL_3ARGS(func, args[0], args[1], args[2]);
break;
case 4:
result = CALL_4ARGS(func, args[0], args[1], args[2], args[3]);
break;
case 5:
result =
CALL_5ARGS(func, args[0], args[1], args[2], args[3], args[4]);
break;
case 6:
result = CALL_6ARGS(func, args[0], args[1], args[2], args[3],
args[4], args[5]);
break;
default:
list = NewPlistFromArray(args, narg);
result = CALL_XARGS(func, list);
}
}
else {
list = NewPlistFromArray(args, narg);
result = DoOperation2Args(CallFuncListOper, func, list);
}
return result;
}
/****************************************************************************
**
*F CleanObjWPObjCopy( <obj> ) . . . . . . . . . . . . . . clean WPobj copy
*/
void CleanObjWPObjCopy (
Obj obj )
{
UInt i; /* loop variable */
Obj elm; /* subobject */
/* remove the forwarding pointer */
ADDR_OBJ(obj)[0] = ELM_PLIST( ADDR_OBJ(obj)[0], 1 );
CHANGED_BAG(obj);
/* now it is cleaned */
RetypeBag( obj, TNUM_OBJ(obj) - COPYING );
/* clean the subvalues */
for ( i = 1; i < SIZE_OBJ(obj)/sizeof(Obj); i++ ) {
elm = ADDR_OBJ(obj)[i];
if ( elm != 0 && !IS_WEAK_DEAD_BAG(elm))
CLEAN_OBJ( elm );
}
}
Obj FuncMultRowVectorVecFFEs( Obj self, Obj vec, Obj mult )
{
Obj *ptr;
FFV valM;
FFV valS;
FFV val;
FF fld;
FFV *succ;
UInt len;
UInt xtype;
UInt i;
if (TNUM_OBJ(mult) != T_FFE)
return TRY_NEXT_METHOD;
if (VAL_FFE(mult) == 1)
return (Obj) 0;
xtype = KTNumPlist(vec, (Obj *) 0);
if (xtype != T_PLIST_FFE &&
xtype != T_PLIST_FFE + IMMUTABLE)
return TRY_NEXT_METHOD;
/* check the lengths */
len = LEN_PLIST(vec);
fld = FLD_FFE(ELM_PLIST(vec, 1));
/* Now check the multiplier field */
if (FLD_FFE(mult) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) != CHAR_FF(FLD_FFE(mult))) {
mult = ErrorReturnObj(
"MultRowVector: <multiplier> has different field",
0L, 0L,
"you can replace <multiplier> via 'return <multiplier>;'");
return CALL_2ARGS(MultRowVectorOp, vec, mult);
}
/* if the multiplier is over a non subfield then redispatch */
if ((DEGR_FF(fld) % DegreeFFE(mult)) != 0)
return TRY_NEXT_METHOD;
/* otherwise it's a subfield, so promote it */
valM = VAL_FFE(mult);
if (valM != 0)
valM = 1 + (valM - 1) * (SIZE_FF(fld) - 1) / (SIZE_FF(FLD_FFE(mult)) - 1);
} else
valM = VAL_FFE(mult);
succ = SUCC_FF(fld);
ptr = ADDR_OBJ(vec);
/* two versions of the loop to avoid multipling by 0 */
if (valM == 0) {
Obj z;
z = NEW_FFE(fld, 0);
for (i = 1; i <= len; i++) {
ptr[i] = z;
}
} else
for (i = 1; i <= len; i++) {
val = VAL_FFE(ptr[i]);
valS = PROD_FFV(val, valM, succ);
ptr[i] = NEW_FFE(fld, valS);
}
return (Obj) 0;
}
Obj FuncAddRowVectorVecFFEsMult( Obj self, Obj vecL, Obj vecR, Obj mult )
{
Obj *ptrL;
Obj *ptrR;
FFV valM;
FFV valS;
FFV valL;
FFV valR;
FF fld;
FFV *succ;
UInt len;
UInt xtype;
UInt i;
if (TNUM_OBJ(mult) != T_FFE)
return TRY_NEXT_METHOD;
if (VAL_FFE(mult) == 0)
return (Obj) 0;
xtype = KTNumPlist(vecL, (Obj *) 0);
if (xtype != T_PLIST_FFE && xtype != T_PLIST_FFE + IMMUTABLE)
return TRY_NEXT_METHOD;
xtype = KTNumPlist(vecR, (Obj *) 0);
if (xtype != T_PLIST_FFE && xtype != T_PLIST_FFE + IMMUTABLE)
return TRY_NEXT_METHOD;
/* check the lengths */
len = LEN_PLIST(vecL);
if (len != LEN_PLIST(vecR)) {
vecR = ErrorReturnObj(
"AddRowVector: vector lengths differ <left> %d, <right> %d",
(Int)len, (Int)LEN_PLIST(vecR),
"you can replace vector <right> via 'return <right>;'");
return CALL_3ARGS(AddRowVectorOp, vecL, vecR, mult);
}
/* check the fields */
fld = FLD_FFE(ELM_PLIST(vecL, 1));
if (FLD_FFE(ELM_PLIST(vecR, 1)) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(ELM_PLIST(vecR, 1))))
return TRY_NEXT_METHOD;
vecR = ErrorReturnObj(
"AddRowVector: vectors have different fields",
0L, 0L,
"you can replace vector <right> via 'return <right>;'");
return CALL_3ARGS(AddRowVectorOp, vecL, vecR, mult);
}
/* Now check the multiplier field */
if (FLD_FFE(mult) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) != CHAR_FF(FLD_FFE(mult))) {
mult = ErrorReturnObj(
"AddRowVector: <multiplier> has different field",
0L, 0L,
"you can replace <multiplier> via 'return <multiplier>;'");
return CALL_3ARGS(AddRowVectorOp, vecL, vecR, mult);
}
/* if the multiplier is over a non subfield then redispatch */
if ((DEGR_FF(fld) % DegreeFFE(mult)) != 0)
return TRY_NEXT_METHOD;
/* otherwise it's a subfield, so promote it */
valM = VAL_FFE(mult);
if (valM != 0)
valM = 1 + (valM - 1) * (SIZE_FF(fld) - 1) / (SIZE_FF(FLD_FFE(mult)) - 1);
} else
valM = VAL_FFE(mult);
succ = SUCC_FF(fld);
ptrL = ADDR_OBJ(vecL);
ptrR = ADDR_OBJ(vecR);
/* two versions of the loop to avoid multipling by 1 */
if (valM == 1)
for (i = 1; i <= len; i++) {
valL = VAL_FFE(ptrL[i]);
valR = VAL_FFE(ptrR[i]);
valS = SUM_FFV(valL, valR, succ);
ptrL[i] = NEW_FFE(fld, valS);
}
else
for (i = 1; i <= len; i++) {
valL = VAL_FFE(ptrL[i]);
valR = VAL_FFE(ptrR[i]);
valS = PROD_FFV(valR, valM, succ);
valS = SUM_FFV(valL, valS, succ);
ptrL[i] = NEW_FFE(fld, valS);
}
return (Obj) 0;
}
/****************************************************************************
**
*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 );
}
}
Obj FuncIsWPObj( Obj self, Obj wp)
{
return (TNUM_OBJ(wp) == T_WPOBJ) ? True : False;
}
static inline int IsBasicObj(Obj obj) {
return !obj || TNUM_OBJ(obj) <= T_MACFLOAT;
}
static void SerializeBinary(Obj obj) {
WriteTNum(TNUM_OBJ(obj));
WriteByteBlock(obj, 0, SIZE_OBJ(obj));
}
static inline int IsBasicObj(Obj obj)
{
// FIXME: hard coding T_MACFLOAT like this seems like a bad idea
return !obj || TNUM_OBJ(obj) <= T_MACFLOAT;
}
